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

-- * Exported types
    TextBuffer(..)                          ,
    TextBufferK                             ,
    toTextBuffer                            ,
    noTextBuffer                            ,


 -- * Methods
-- ** textBufferAddMark
    textBufferAddMark                       ,


-- ** textBufferAddSelectionClipboard
    textBufferAddSelectionClipboard         ,


-- ** textBufferApplyTag
    textBufferApplyTag                      ,


-- ** textBufferApplyTagByName
    textBufferApplyTagByName                ,


-- ** textBufferBackspace
    textBufferBackspace                     ,


-- ** textBufferBeginUserAction
    textBufferBeginUserAction               ,


-- ** textBufferCopyClipboard
    textBufferCopyClipboard                 ,


-- ** textBufferCreateChildAnchor
    textBufferCreateChildAnchor             ,


-- ** textBufferCreateMark
    textBufferCreateMark                    ,


-- ** textBufferCutClipboard
    textBufferCutClipboard                  ,


-- ** textBufferDelete
    textBufferDelete                        ,


-- ** textBufferDeleteInteractive
    textBufferDeleteInteractive             ,


-- ** textBufferDeleteMark
    textBufferDeleteMark                    ,


-- ** textBufferDeleteMarkByName
    textBufferDeleteMarkByName              ,


-- ** textBufferDeleteSelection
    textBufferDeleteSelection               ,


-- ** textBufferDeserialize
    textBufferDeserialize                   ,


-- ** textBufferDeserializeGetCanCreateTags
    textBufferDeserializeGetCanCreateTags   ,


-- ** textBufferDeserializeSetCanCreateTags
    textBufferDeserializeSetCanCreateTags   ,


-- ** textBufferEndUserAction
    textBufferEndUserAction                 ,


-- ** textBufferGetBounds
    textBufferGetBounds                     ,


-- ** textBufferGetCharCount
    textBufferGetCharCount                  ,


-- ** textBufferGetCopyTargetList
    textBufferGetCopyTargetList             ,


-- ** textBufferGetDeserializeFormats
    textBufferGetDeserializeFormats         ,


-- ** textBufferGetEndIter
    textBufferGetEndIter                    ,


-- ** textBufferGetHasSelection
    textBufferGetHasSelection               ,


-- ** textBufferGetInsert
    textBufferGetInsert                     ,


-- ** textBufferGetIterAtChildAnchor
    textBufferGetIterAtChildAnchor          ,


-- ** textBufferGetIterAtLine
    textBufferGetIterAtLine                 ,


-- ** textBufferGetIterAtLineIndex
    textBufferGetIterAtLineIndex            ,


-- ** textBufferGetIterAtLineOffset
    textBufferGetIterAtLineOffset           ,


-- ** textBufferGetIterAtMark
    textBufferGetIterAtMark                 ,


-- ** textBufferGetIterAtOffset
    textBufferGetIterAtOffset               ,


-- ** textBufferGetLineCount
    textBufferGetLineCount                  ,


-- ** textBufferGetMark
    textBufferGetMark                       ,


-- ** textBufferGetModified
    textBufferGetModified                   ,


-- ** textBufferGetPasteTargetList
    textBufferGetPasteTargetList            ,


-- ** textBufferGetSelectionBound
    textBufferGetSelectionBound             ,


-- ** textBufferGetSelectionBounds
    textBufferGetSelectionBounds            ,


-- ** textBufferGetSerializeFormats
    textBufferGetSerializeFormats           ,


-- ** textBufferGetSlice
    textBufferGetSlice                      ,


-- ** textBufferGetStartIter
    textBufferGetStartIter                  ,


-- ** textBufferGetTagTable
    textBufferGetTagTable                   ,


-- ** textBufferGetText
    textBufferGetText                       ,


-- ** textBufferInsert
    textBufferInsert                        ,


-- ** textBufferInsertAtCursor
    textBufferInsertAtCursor                ,


-- ** textBufferInsertChildAnchor
    textBufferInsertChildAnchor             ,


-- ** textBufferInsertInteractive
    textBufferInsertInteractive             ,


-- ** textBufferInsertInteractiveAtCursor
    textBufferInsertInteractiveAtCursor     ,


-- ** textBufferInsertMarkup
    textBufferInsertMarkup                  ,


-- ** textBufferInsertPixbuf
    textBufferInsertPixbuf                  ,


-- ** textBufferInsertRange
    textBufferInsertRange                   ,


-- ** textBufferInsertRangeInteractive
    textBufferInsertRangeInteractive        ,


-- ** textBufferMoveMark
    textBufferMoveMark                      ,


-- ** textBufferMoveMarkByName
    textBufferMoveMarkByName                ,


-- ** textBufferNew
    textBufferNew                           ,


-- ** textBufferPasteClipboard
    textBufferPasteClipboard                ,


-- ** textBufferPlaceCursor
    textBufferPlaceCursor                   ,


-- ** textBufferRegisterDeserializeFormat
    textBufferRegisterDeserializeFormat     ,


-- ** textBufferRegisterDeserializeTagset
    textBufferRegisterDeserializeTagset     ,


-- ** textBufferRegisterSerializeFormat
    textBufferRegisterSerializeFormat       ,


-- ** textBufferRegisterSerializeTagset
    textBufferRegisterSerializeTagset       ,


-- ** textBufferRemoveAllTags
    textBufferRemoveAllTags                 ,


-- ** textBufferRemoveSelectionClipboard
    textBufferRemoveSelectionClipboard      ,


-- ** textBufferRemoveTag
    textBufferRemoveTag                     ,


-- ** textBufferRemoveTagByName
    textBufferRemoveTagByName               ,


-- ** textBufferSelectRange
    textBufferSelectRange                   ,


-- ** textBufferSerialize
    textBufferSerialize                     ,


-- ** textBufferSetModified
    textBufferSetModified                   ,


-- ** textBufferSetText
    textBufferSetText                       ,


-- ** textBufferUnregisterDeserializeFormat
    textBufferUnregisterDeserializeFormat   ,


-- ** textBufferUnregisterSerializeFormat
    textBufferUnregisterSerializeFormat     ,




 -- * Properties
-- ** CopyTargetList
    TextBufferCopyTargetListPropertyInfo    ,
    getTextBufferCopyTargetList             ,


-- ** CursorPosition
    TextBufferCursorPositionPropertyInfo    ,
    getTextBufferCursorPosition             ,


-- ** HasSelection
    TextBufferHasSelectionPropertyInfo      ,
    getTextBufferHasSelection               ,


-- ** PasteTargetList
    TextBufferPasteTargetListPropertyInfo   ,
    getTextBufferPasteTargetList            ,


-- ** TagTable
    TextBufferTagTablePropertyInfo          ,
    constructTextBufferTagTable             ,
    getTextBufferTagTable                   ,


-- ** Text
    TextBufferTextPropertyInfo              ,
    constructTextBufferText                 ,
    getTextBufferText                       ,
    setTextBufferText                       ,




 -- * Signals
-- ** ApplyTag
    TextBufferApplyTagCallback              ,
    TextBufferApplyTagCallbackC             ,
    TextBufferApplyTagSignalInfo            ,
    afterTextBufferApplyTag                 ,
    mkTextBufferApplyTagCallback            ,
    noTextBufferApplyTagCallback            ,
    onTextBufferApplyTag                    ,
    textBufferApplyTagCallbackWrapper       ,
    textBufferApplyTagClosure               ,


-- ** BeginUserAction
    TextBufferBeginUserActionCallback       ,
    TextBufferBeginUserActionCallbackC      ,
    TextBufferBeginUserActionSignalInfo     ,
    afterTextBufferBeginUserAction          ,
    mkTextBufferBeginUserActionCallback     ,
    noTextBufferBeginUserActionCallback     ,
    onTextBufferBeginUserAction             ,
    textBufferBeginUserActionCallbackWrapper,
    textBufferBeginUserActionClosure        ,


-- ** Changed
    TextBufferChangedCallback               ,
    TextBufferChangedCallbackC              ,
    TextBufferChangedSignalInfo             ,
    afterTextBufferChanged                  ,
    mkTextBufferChangedCallback             ,
    noTextBufferChangedCallback             ,
    onTextBufferChanged                     ,
    textBufferChangedCallbackWrapper        ,
    textBufferChangedClosure                ,


-- ** DeleteRange
    TextBufferDeleteRangeCallback           ,
    TextBufferDeleteRangeCallbackC          ,
    TextBufferDeleteRangeSignalInfo         ,
    afterTextBufferDeleteRange              ,
    mkTextBufferDeleteRangeCallback         ,
    noTextBufferDeleteRangeCallback         ,
    onTextBufferDeleteRange                 ,
    textBufferDeleteRangeCallbackWrapper    ,
    textBufferDeleteRangeClosure            ,


-- ** EndUserAction
    TextBufferEndUserActionCallback         ,
    TextBufferEndUserActionCallbackC        ,
    TextBufferEndUserActionSignalInfo       ,
    afterTextBufferEndUserAction            ,
    mkTextBufferEndUserActionCallback       ,
    noTextBufferEndUserActionCallback       ,
    onTextBufferEndUserAction               ,
    textBufferEndUserActionCallbackWrapper  ,
    textBufferEndUserActionClosure          ,


-- ** InsertChildAnchor
    TextBufferInsertChildAnchorCallback     ,
    TextBufferInsertChildAnchorCallbackC    ,
    TextBufferInsertChildAnchorSignalInfo   ,
    afterTextBufferInsertChildAnchor        ,
    mkTextBufferInsertChildAnchorCallback   ,
    noTextBufferInsertChildAnchorCallback   ,
    onTextBufferInsertChildAnchor           ,
    textBufferInsertChildAnchorCallbackWrapper,
    textBufferInsertChildAnchorClosure      ,


-- ** InsertPixbuf
    TextBufferInsertPixbufCallback          ,
    TextBufferInsertPixbufCallbackC         ,
    TextBufferInsertPixbufSignalInfo        ,
    afterTextBufferInsertPixbuf             ,
    mkTextBufferInsertPixbufCallback        ,
    noTextBufferInsertPixbufCallback        ,
    onTextBufferInsertPixbuf                ,
    textBufferInsertPixbufCallbackWrapper   ,
    textBufferInsertPixbufClosure           ,


-- ** InsertText
    TextBufferInsertTextCallback            ,
    TextBufferInsertTextCallbackC           ,
    TextBufferInsertTextSignalInfo          ,
    afterTextBufferInsertText               ,
    mkTextBufferInsertTextCallback          ,
    noTextBufferInsertTextCallback          ,
    onTextBufferInsertText                  ,
    textBufferInsertTextCallbackWrapper     ,
    textBufferInsertTextClosure             ,


-- ** MarkDeleted
    TextBufferMarkDeletedCallback           ,
    TextBufferMarkDeletedCallbackC          ,
    TextBufferMarkDeletedSignalInfo         ,
    afterTextBufferMarkDeleted              ,
    mkTextBufferMarkDeletedCallback         ,
    noTextBufferMarkDeletedCallback         ,
    onTextBufferMarkDeleted                 ,
    textBufferMarkDeletedCallbackWrapper    ,
    textBufferMarkDeletedClosure            ,


-- ** MarkSet
    TextBufferMarkSetCallback               ,
    TextBufferMarkSetCallbackC              ,
    TextBufferMarkSetSignalInfo             ,
    afterTextBufferMarkSet                  ,
    mkTextBufferMarkSetCallback             ,
    noTextBufferMarkSetCallback             ,
    onTextBufferMarkSet                     ,
    textBufferMarkSetCallbackWrapper        ,
    textBufferMarkSetClosure                ,


-- ** ModifiedChanged
    TextBufferModifiedChangedCallback       ,
    TextBufferModifiedChangedCallbackC      ,
    TextBufferModifiedChangedSignalInfo     ,
    afterTextBufferModifiedChanged          ,
    mkTextBufferModifiedChangedCallback     ,
    noTextBufferModifiedChangedCallback     ,
    onTextBufferModifiedChanged             ,
    textBufferModifiedChangedCallbackWrapper,
    textBufferModifiedChangedClosure        ,


-- ** PasteDone
    TextBufferPasteDoneCallback             ,
    TextBufferPasteDoneCallbackC            ,
    TextBufferPasteDoneSignalInfo           ,
    afterTextBufferPasteDone                ,
    mkTextBufferPasteDoneCallback           ,
    noTextBufferPasteDoneCallback           ,
    onTextBufferPasteDone                   ,
    textBufferPasteDoneCallbackWrapper      ,
    textBufferPasteDoneClosure              ,


-- ** RemoveTag
    TextBufferRemoveTagCallback             ,
    TextBufferRemoveTagCallbackC            ,
    TextBufferRemoveTagSignalInfo           ,
    afterTextBufferRemoveTag                ,
    mkTextBufferRemoveTagCallback           ,
    noTextBufferRemoveTagCallback           ,
    onTextBufferRemoveTag                   ,
    textBufferRemoveTagCallbackWrapper      ,
    textBufferRemoveTagClosure              ,




    ) 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.GLib as GLib
import qualified GI.GObject as GObject
import qualified GI.Gdk as Gdk
import qualified GI.GdkPixbuf as GdkPixbuf

newtype TextBuffer = TextBuffer (ForeignPtr TextBuffer)
foreign import ccall "gtk_text_buffer_get_type"
    c_gtk_text_buffer_get_type :: IO GType

type instance ParentTypes TextBuffer = TextBufferParentTypes
type TextBufferParentTypes = '[GObject.Object]

instance GObject TextBuffer where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_gtk_text_buffer_get_type
    

class GObject o => TextBufferK o
instance (GObject o, IsDescendantOf TextBuffer o) => TextBufferK o

toTextBuffer :: TextBufferK o => o -> IO TextBuffer
toTextBuffer = unsafeCastTo TextBuffer

noTextBuffer :: Maybe TextBuffer
noTextBuffer = Nothing

-- signal TextBuffer::apply-tag
type TextBufferApplyTagCallback =
    TextTag ->
    TextIter ->
    TextIter ->
    IO ()

noTextBufferApplyTagCallback :: Maybe TextBufferApplyTagCallback
noTextBufferApplyTagCallback = Nothing

type TextBufferApplyTagCallbackC =
    Ptr () ->                               -- object
    Ptr TextTag ->
    Ptr TextIter ->
    Ptr TextIter ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextBufferApplyTagCallback :: TextBufferApplyTagCallbackC -> IO (FunPtr TextBufferApplyTagCallbackC)

textBufferApplyTagClosure :: TextBufferApplyTagCallback -> IO Closure
textBufferApplyTagClosure cb = newCClosure =<< mkTextBufferApplyTagCallback wrapped
    where wrapped = textBufferApplyTagCallbackWrapper cb

textBufferApplyTagCallbackWrapper ::
    TextBufferApplyTagCallback ->
    Ptr () ->
    Ptr TextTag ->
    Ptr TextIter ->
    Ptr TextIter ->
    Ptr () ->
    IO ()
textBufferApplyTagCallbackWrapper _cb _ tag start end _ = do
    tag' <- (newObject TextTag) tag
    start' <- (newBoxed TextIter) start
    end' <- (newBoxed TextIter) end
    _cb  tag' start' end'

onTextBufferApplyTag :: (GObject a, MonadIO m) => a -> TextBufferApplyTagCallback -> m SignalHandlerId
onTextBufferApplyTag obj cb = liftIO $ connectTextBufferApplyTag obj cb SignalConnectBefore
afterTextBufferApplyTag :: (GObject a, MonadIO m) => a -> TextBufferApplyTagCallback -> m SignalHandlerId
afterTextBufferApplyTag obj cb = connectTextBufferApplyTag obj cb SignalConnectAfter

connectTextBufferApplyTag :: (GObject a, MonadIO m) =>
                             a -> TextBufferApplyTagCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferApplyTag obj cb after = liftIO $ do
    cb' <- mkTextBufferApplyTagCallback (textBufferApplyTagCallbackWrapper cb)
    connectSignalFunPtr obj "apply-tag" cb' after

-- signal TextBuffer::begin-user-action
type TextBufferBeginUserActionCallback =
    IO ()

noTextBufferBeginUserActionCallback :: Maybe TextBufferBeginUserActionCallback
noTextBufferBeginUserActionCallback = Nothing

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

foreign import ccall "wrapper"
    mkTextBufferBeginUserActionCallback :: TextBufferBeginUserActionCallbackC -> IO (FunPtr TextBufferBeginUserActionCallbackC)

textBufferBeginUserActionClosure :: TextBufferBeginUserActionCallback -> IO Closure
textBufferBeginUserActionClosure cb = newCClosure =<< mkTextBufferBeginUserActionCallback wrapped
    where wrapped = textBufferBeginUserActionCallbackWrapper cb

textBufferBeginUserActionCallbackWrapper ::
    TextBufferBeginUserActionCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
textBufferBeginUserActionCallbackWrapper _cb _ _ = do
    _cb 

onTextBufferBeginUserAction :: (GObject a, MonadIO m) => a -> TextBufferBeginUserActionCallback -> m SignalHandlerId
onTextBufferBeginUserAction obj cb = liftIO $ connectTextBufferBeginUserAction obj cb SignalConnectBefore
afterTextBufferBeginUserAction :: (GObject a, MonadIO m) => a -> TextBufferBeginUserActionCallback -> m SignalHandlerId
afterTextBufferBeginUserAction obj cb = connectTextBufferBeginUserAction obj cb SignalConnectAfter

connectTextBufferBeginUserAction :: (GObject a, MonadIO m) =>
                                    a -> TextBufferBeginUserActionCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferBeginUserAction obj cb after = liftIO $ do
    cb' <- mkTextBufferBeginUserActionCallback (textBufferBeginUserActionCallbackWrapper cb)
    connectSignalFunPtr obj "begin-user-action" cb' after

-- signal TextBuffer::changed
type TextBufferChangedCallback =
    IO ()

noTextBufferChangedCallback :: Maybe TextBufferChangedCallback
noTextBufferChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTextBufferChangedCallback :: TextBufferChangedCallbackC -> IO (FunPtr TextBufferChangedCallbackC)

textBufferChangedClosure :: TextBufferChangedCallback -> IO Closure
textBufferChangedClosure cb = newCClosure =<< mkTextBufferChangedCallback wrapped
    where wrapped = textBufferChangedCallbackWrapper cb

textBufferChangedCallbackWrapper ::
    TextBufferChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
textBufferChangedCallbackWrapper _cb _ _ = do
    _cb 

onTextBufferChanged :: (GObject a, MonadIO m) => a -> TextBufferChangedCallback -> m SignalHandlerId
onTextBufferChanged obj cb = liftIO $ connectTextBufferChanged obj cb SignalConnectBefore
afterTextBufferChanged :: (GObject a, MonadIO m) => a -> TextBufferChangedCallback -> m SignalHandlerId
afterTextBufferChanged obj cb = connectTextBufferChanged obj cb SignalConnectAfter

connectTextBufferChanged :: (GObject a, MonadIO m) =>
                            a -> TextBufferChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferChanged obj cb after = liftIO $ do
    cb' <- mkTextBufferChangedCallback (textBufferChangedCallbackWrapper cb)
    connectSignalFunPtr obj "changed" cb' after

-- signal TextBuffer::delete-range
type TextBufferDeleteRangeCallback =
    TextIter ->
    TextIter ->
    IO ()

noTextBufferDeleteRangeCallback :: Maybe TextBufferDeleteRangeCallback
noTextBufferDeleteRangeCallback = Nothing

type TextBufferDeleteRangeCallbackC =
    Ptr () ->                               -- object
    Ptr TextIter ->
    Ptr TextIter ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextBufferDeleteRangeCallback :: TextBufferDeleteRangeCallbackC -> IO (FunPtr TextBufferDeleteRangeCallbackC)

textBufferDeleteRangeClosure :: TextBufferDeleteRangeCallback -> IO Closure
textBufferDeleteRangeClosure cb = newCClosure =<< mkTextBufferDeleteRangeCallback wrapped
    where wrapped = textBufferDeleteRangeCallbackWrapper cb

textBufferDeleteRangeCallbackWrapper ::
    TextBufferDeleteRangeCallback ->
    Ptr () ->
    Ptr TextIter ->
    Ptr TextIter ->
    Ptr () ->
    IO ()
textBufferDeleteRangeCallbackWrapper _cb _ start end _ = do
    start' <- (newBoxed TextIter) start
    end' <- (newBoxed TextIter) end
    _cb  start' end'

onTextBufferDeleteRange :: (GObject a, MonadIO m) => a -> TextBufferDeleteRangeCallback -> m SignalHandlerId
onTextBufferDeleteRange obj cb = liftIO $ connectTextBufferDeleteRange obj cb SignalConnectBefore
afterTextBufferDeleteRange :: (GObject a, MonadIO m) => a -> TextBufferDeleteRangeCallback -> m SignalHandlerId
afterTextBufferDeleteRange obj cb = connectTextBufferDeleteRange obj cb SignalConnectAfter

connectTextBufferDeleteRange :: (GObject a, MonadIO m) =>
                                a -> TextBufferDeleteRangeCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferDeleteRange obj cb after = liftIO $ do
    cb' <- mkTextBufferDeleteRangeCallback (textBufferDeleteRangeCallbackWrapper cb)
    connectSignalFunPtr obj "delete-range" cb' after

-- signal TextBuffer::end-user-action
type TextBufferEndUserActionCallback =
    IO ()

noTextBufferEndUserActionCallback :: Maybe TextBufferEndUserActionCallback
noTextBufferEndUserActionCallback = Nothing

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

foreign import ccall "wrapper"
    mkTextBufferEndUserActionCallback :: TextBufferEndUserActionCallbackC -> IO (FunPtr TextBufferEndUserActionCallbackC)

textBufferEndUserActionClosure :: TextBufferEndUserActionCallback -> IO Closure
textBufferEndUserActionClosure cb = newCClosure =<< mkTextBufferEndUserActionCallback wrapped
    where wrapped = textBufferEndUserActionCallbackWrapper cb

textBufferEndUserActionCallbackWrapper ::
    TextBufferEndUserActionCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
textBufferEndUserActionCallbackWrapper _cb _ _ = do
    _cb 

onTextBufferEndUserAction :: (GObject a, MonadIO m) => a -> TextBufferEndUserActionCallback -> m SignalHandlerId
onTextBufferEndUserAction obj cb = liftIO $ connectTextBufferEndUserAction obj cb SignalConnectBefore
afterTextBufferEndUserAction :: (GObject a, MonadIO m) => a -> TextBufferEndUserActionCallback -> m SignalHandlerId
afterTextBufferEndUserAction obj cb = connectTextBufferEndUserAction obj cb SignalConnectAfter

connectTextBufferEndUserAction :: (GObject a, MonadIO m) =>
                                  a -> TextBufferEndUserActionCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferEndUserAction obj cb after = liftIO $ do
    cb' <- mkTextBufferEndUserActionCallback (textBufferEndUserActionCallbackWrapper cb)
    connectSignalFunPtr obj "end-user-action" cb' after

-- signal TextBuffer::insert-child-anchor
type TextBufferInsertChildAnchorCallback =
    TextIter ->
    TextChildAnchor ->
    IO ()

noTextBufferInsertChildAnchorCallback :: Maybe TextBufferInsertChildAnchorCallback
noTextBufferInsertChildAnchorCallback = Nothing

type TextBufferInsertChildAnchorCallbackC =
    Ptr () ->                               -- object
    Ptr TextIter ->
    Ptr TextChildAnchor ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextBufferInsertChildAnchorCallback :: TextBufferInsertChildAnchorCallbackC -> IO (FunPtr TextBufferInsertChildAnchorCallbackC)

textBufferInsertChildAnchorClosure :: TextBufferInsertChildAnchorCallback -> IO Closure
textBufferInsertChildAnchorClosure cb = newCClosure =<< mkTextBufferInsertChildAnchorCallback wrapped
    where wrapped = textBufferInsertChildAnchorCallbackWrapper cb

textBufferInsertChildAnchorCallbackWrapper ::
    TextBufferInsertChildAnchorCallback ->
    Ptr () ->
    Ptr TextIter ->
    Ptr TextChildAnchor ->
    Ptr () ->
    IO ()
textBufferInsertChildAnchorCallbackWrapper _cb _ location anchor _ = do
    location' <- (newBoxed TextIter) location
    anchor' <- (newObject TextChildAnchor) anchor
    _cb  location' anchor'

onTextBufferInsertChildAnchor :: (GObject a, MonadIO m) => a -> TextBufferInsertChildAnchorCallback -> m SignalHandlerId
onTextBufferInsertChildAnchor obj cb = liftIO $ connectTextBufferInsertChildAnchor obj cb SignalConnectBefore
afterTextBufferInsertChildAnchor :: (GObject a, MonadIO m) => a -> TextBufferInsertChildAnchorCallback -> m SignalHandlerId
afterTextBufferInsertChildAnchor obj cb = connectTextBufferInsertChildAnchor obj cb SignalConnectAfter

connectTextBufferInsertChildAnchor :: (GObject a, MonadIO m) =>
                                      a -> TextBufferInsertChildAnchorCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferInsertChildAnchor obj cb after = liftIO $ do
    cb' <- mkTextBufferInsertChildAnchorCallback (textBufferInsertChildAnchorCallbackWrapper cb)
    connectSignalFunPtr obj "insert-child-anchor" cb' after

-- signal TextBuffer::insert-pixbuf
type TextBufferInsertPixbufCallback =
    TextIter ->
    GdkPixbuf.Pixbuf ->
    IO ()

noTextBufferInsertPixbufCallback :: Maybe TextBufferInsertPixbufCallback
noTextBufferInsertPixbufCallback = Nothing

type TextBufferInsertPixbufCallbackC =
    Ptr () ->                               -- object
    Ptr TextIter ->
    Ptr GdkPixbuf.Pixbuf ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextBufferInsertPixbufCallback :: TextBufferInsertPixbufCallbackC -> IO (FunPtr TextBufferInsertPixbufCallbackC)

textBufferInsertPixbufClosure :: TextBufferInsertPixbufCallback -> IO Closure
textBufferInsertPixbufClosure cb = newCClosure =<< mkTextBufferInsertPixbufCallback wrapped
    where wrapped = textBufferInsertPixbufCallbackWrapper cb

textBufferInsertPixbufCallbackWrapper ::
    TextBufferInsertPixbufCallback ->
    Ptr () ->
    Ptr TextIter ->
    Ptr GdkPixbuf.Pixbuf ->
    Ptr () ->
    IO ()
textBufferInsertPixbufCallbackWrapper _cb _ location pixbuf _ = do
    location' <- (newBoxed TextIter) location
    pixbuf' <- (newObject GdkPixbuf.Pixbuf) pixbuf
    _cb  location' pixbuf'

onTextBufferInsertPixbuf :: (GObject a, MonadIO m) => a -> TextBufferInsertPixbufCallback -> m SignalHandlerId
onTextBufferInsertPixbuf obj cb = liftIO $ connectTextBufferInsertPixbuf obj cb SignalConnectBefore
afterTextBufferInsertPixbuf :: (GObject a, MonadIO m) => a -> TextBufferInsertPixbufCallback -> m SignalHandlerId
afterTextBufferInsertPixbuf obj cb = connectTextBufferInsertPixbuf obj cb SignalConnectAfter

connectTextBufferInsertPixbuf :: (GObject a, MonadIO m) =>
                                 a -> TextBufferInsertPixbufCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferInsertPixbuf obj cb after = liftIO $ do
    cb' <- mkTextBufferInsertPixbufCallback (textBufferInsertPixbufCallbackWrapper cb)
    connectSignalFunPtr obj "insert-pixbuf" cb' after

-- signal TextBuffer::insert-text
type TextBufferInsertTextCallback =
    TextIter ->
    T.Text ->
    Int32 ->
    IO ()

noTextBufferInsertTextCallback :: Maybe TextBufferInsertTextCallback
noTextBufferInsertTextCallback = Nothing

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

foreign import ccall "wrapper"
    mkTextBufferInsertTextCallback :: TextBufferInsertTextCallbackC -> IO (FunPtr TextBufferInsertTextCallbackC)

textBufferInsertTextClosure :: TextBufferInsertTextCallback -> IO Closure
textBufferInsertTextClosure cb = newCClosure =<< mkTextBufferInsertTextCallback wrapped
    where wrapped = textBufferInsertTextCallbackWrapper cb

textBufferInsertTextCallbackWrapper ::
    TextBufferInsertTextCallback ->
    Ptr () ->
    Ptr TextIter ->
    CString ->
    Int32 ->
    Ptr () ->
    IO ()
textBufferInsertTextCallbackWrapper _cb _ location text len _ = do
    location' <- (newBoxed TextIter) location
    text' <- cstringToText text
    _cb  location' text' len

onTextBufferInsertText :: (GObject a, MonadIO m) => a -> TextBufferInsertTextCallback -> m SignalHandlerId
onTextBufferInsertText obj cb = liftIO $ connectTextBufferInsertText obj cb SignalConnectBefore
afterTextBufferInsertText :: (GObject a, MonadIO m) => a -> TextBufferInsertTextCallback -> m SignalHandlerId
afterTextBufferInsertText obj cb = connectTextBufferInsertText obj cb SignalConnectAfter

connectTextBufferInsertText :: (GObject a, MonadIO m) =>
                               a -> TextBufferInsertTextCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferInsertText obj cb after = liftIO $ do
    cb' <- mkTextBufferInsertTextCallback (textBufferInsertTextCallbackWrapper cb)
    connectSignalFunPtr obj "insert-text" cb' after

-- signal TextBuffer::mark-deleted
type TextBufferMarkDeletedCallback =
    TextMark ->
    IO ()

noTextBufferMarkDeletedCallback :: Maybe TextBufferMarkDeletedCallback
noTextBufferMarkDeletedCallback = Nothing

type TextBufferMarkDeletedCallbackC =
    Ptr () ->                               -- object
    Ptr TextMark ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextBufferMarkDeletedCallback :: TextBufferMarkDeletedCallbackC -> IO (FunPtr TextBufferMarkDeletedCallbackC)

textBufferMarkDeletedClosure :: TextBufferMarkDeletedCallback -> IO Closure
textBufferMarkDeletedClosure cb = newCClosure =<< mkTextBufferMarkDeletedCallback wrapped
    where wrapped = textBufferMarkDeletedCallbackWrapper cb

textBufferMarkDeletedCallbackWrapper ::
    TextBufferMarkDeletedCallback ->
    Ptr () ->
    Ptr TextMark ->
    Ptr () ->
    IO ()
textBufferMarkDeletedCallbackWrapper _cb _ mark _ = do
    mark' <- (newObject TextMark) mark
    _cb  mark'

onTextBufferMarkDeleted :: (GObject a, MonadIO m) => a -> TextBufferMarkDeletedCallback -> m SignalHandlerId
onTextBufferMarkDeleted obj cb = liftIO $ connectTextBufferMarkDeleted obj cb SignalConnectBefore
afterTextBufferMarkDeleted :: (GObject a, MonadIO m) => a -> TextBufferMarkDeletedCallback -> m SignalHandlerId
afterTextBufferMarkDeleted obj cb = connectTextBufferMarkDeleted obj cb SignalConnectAfter

connectTextBufferMarkDeleted :: (GObject a, MonadIO m) =>
                                a -> TextBufferMarkDeletedCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferMarkDeleted obj cb after = liftIO $ do
    cb' <- mkTextBufferMarkDeletedCallback (textBufferMarkDeletedCallbackWrapper cb)
    connectSignalFunPtr obj "mark-deleted" cb' after

-- signal TextBuffer::mark-set
type TextBufferMarkSetCallback =
    TextIter ->
    TextMark ->
    IO ()

noTextBufferMarkSetCallback :: Maybe TextBufferMarkSetCallback
noTextBufferMarkSetCallback = Nothing

type TextBufferMarkSetCallbackC =
    Ptr () ->                               -- object
    Ptr TextIter ->
    Ptr TextMark ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextBufferMarkSetCallback :: TextBufferMarkSetCallbackC -> IO (FunPtr TextBufferMarkSetCallbackC)

textBufferMarkSetClosure :: TextBufferMarkSetCallback -> IO Closure
textBufferMarkSetClosure cb = newCClosure =<< mkTextBufferMarkSetCallback wrapped
    where wrapped = textBufferMarkSetCallbackWrapper cb

textBufferMarkSetCallbackWrapper ::
    TextBufferMarkSetCallback ->
    Ptr () ->
    Ptr TextIter ->
    Ptr TextMark ->
    Ptr () ->
    IO ()
textBufferMarkSetCallbackWrapper _cb _ location mark _ = do
    location' <- (newBoxed TextIter) location
    mark' <- (newObject TextMark) mark
    _cb  location' mark'

onTextBufferMarkSet :: (GObject a, MonadIO m) => a -> TextBufferMarkSetCallback -> m SignalHandlerId
onTextBufferMarkSet obj cb = liftIO $ connectTextBufferMarkSet obj cb SignalConnectBefore
afterTextBufferMarkSet :: (GObject a, MonadIO m) => a -> TextBufferMarkSetCallback -> m SignalHandlerId
afterTextBufferMarkSet obj cb = connectTextBufferMarkSet obj cb SignalConnectAfter

connectTextBufferMarkSet :: (GObject a, MonadIO m) =>
                            a -> TextBufferMarkSetCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferMarkSet obj cb after = liftIO $ do
    cb' <- mkTextBufferMarkSetCallback (textBufferMarkSetCallbackWrapper cb)
    connectSignalFunPtr obj "mark-set" cb' after

-- signal TextBuffer::modified-changed
type TextBufferModifiedChangedCallback =
    IO ()

noTextBufferModifiedChangedCallback :: Maybe TextBufferModifiedChangedCallback
noTextBufferModifiedChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTextBufferModifiedChangedCallback :: TextBufferModifiedChangedCallbackC -> IO (FunPtr TextBufferModifiedChangedCallbackC)

textBufferModifiedChangedClosure :: TextBufferModifiedChangedCallback -> IO Closure
textBufferModifiedChangedClosure cb = newCClosure =<< mkTextBufferModifiedChangedCallback wrapped
    where wrapped = textBufferModifiedChangedCallbackWrapper cb

textBufferModifiedChangedCallbackWrapper ::
    TextBufferModifiedChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
textBufferModifiedChangedCallbackWrapper _cb _ _ = do
    _cb 

onTextBufferModifiedChanged :: (GObject a, MonadIO m) => a -> TextBufferModifiedChangedCallback -> m SignalHandlerId
onTextBufferModifiedChanged obj cb = liftIO $ connectTextBufferModifiedChanged obj cb SignalConnectBefore
afterTextBufferModifiedChanged :: (GObject a, MonadIO m) => a -> TextBufferModifiedChangedCallback -> m SignalHandlerId
afterTextBufferModifiedChanged obj cb = connectTextBufferModifiedChanged obj cb SignalConnectAfter

connectTextBufferModifiedChanged :: (GObject a, MonadIO m) =>
                                    a -> TextBufferModifiedChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferModifiedChanged obj cb after = liftIO $ do
    cb' <- mkTextBufferModifiedChangedCallback (textBufferModifiedChangedCallbackWrapper cb)
    connectSignalFunPtr obj "modified-changed" cb' after

-- signal TextBuffer::paste-done
type TextBufferPasteDoneCallback =
    Clipboard ->
    IO ()

noTextBufferPasteDoneCallback :: Maybe TextBufferPasteDoneCallback
noTextBufferPasteDoneCallback = Nothing

type TextBufferPasteDoneCallbackC =
    Ptr () ->                               -- object
    Ptr Clipboard ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextBufferPasteDoneCallback :: TextBufferPasteDoneCallbackC -> IO (FunPtr TextBufferPasteDoneCallbackC)

textBufferPasteDoneClosure :: TextBufferPasteDoneCallback -> IO Closure
textBufferPasteDoneClosure cb = newCClosure =<< mkTextBufferPasteDoneCallback wrapped
    where wrapped = textBufferPasteDoneCallbackWrapper cb

textBufferPasteDoneCallbackWrapper ::
    TextBufferPasteDoneCallback ->
    Ptr () ->
    Ptr Clipboard ->
    Ptr () ->
    IO ()
textBufferPasteDoneCallbackWrapper _cb _ clipboard _ = do
    clipboard' <- (newObject Clipboard) clipboard
    _cb  clipboard'

onTextBufferPasteDone :: (GObject a, MonadIO m) => a -> TextBufferPasteDoneCallback -> m SignalHandlerId
onTextBufferPasteDone obj cb = liftIO $ connectTextBufferPasteDone obj cb SignalConnectBefore
afterTextBufferPasteDone :: (GObject a, MonadIO m) => a -> TextBufferPasteDoneCallback -> m SignalHandlerId
afterTextBufferPasteDone obj cb = connectTextBufferPasteDone obj cb SignalConnectAfter

connectTextBufferPasteDone :: (GObject a, MonadIO m) =>
                              a -> TextBufferPasteDoneCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferPasteDone obj cb after = liftIO $ do
    cb' <- mkTextBufferPasteDoneCallback (textBufferPasteDoneCallbackWrapper cb)
    connectSignalFunPtr obj "paste-done" cb' after

-- signal TextBuffer::remove-tag
type TextBufferRemoveTagCallback =
    TextTag ->
    TextIter ->
    TextIter ->
    IO ()

noTextBufferRemoveTagCallback :: Maybe TextBufferRemoveTagCallback
noTextBufferRemoveTagCallback = Nothing

type TextBufferRemoveTagCallbackC =
    Ptr () ->                               -- object
    Ptr TextTag ->
    Ptr TextIter ->
    Ptr TextIter ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTextBufferRemoveTagCallback :: TextBufferRemoveTagCallbackC -> IO (FunPtr TextBufferRemoveTagCallbackC)

textBufferRemoveTagClosure :: TextBufferRemoveTagCallback -> IO Closure
textBufferRemoveTagClosure cb = newCClosure =<< mkTextBufferRemoveTagCallback wrapped
    where wrapped = textBufferRemoveTagCallbackWrapper cb

textBufferRemoveTagCallbackWrapper ::
    TextBufferRemoveTagCallback ->
    Ptr () ->
    Ptr TextTag ->
    Ptr TextIter ->
    Ptr TextIter ->
    Ptr () ->
    IO ()
textBufferRemoveTagCallbackWrapper _cb _ tag start end _ = do
    tag' <- (newObject TextTag) tag
    start' <- (newBoxed TextIter) start
    end' <- (newBoxed TextIter) end
    _cb  tag' start' end'

onTextBufferRemoveTag :: (GObject a, MonadIO m) => a -> TextBufferRemoveTagCallback -> m SignalHandlerId
onTextBufferRemoveTag obj cb = liftIO $ connectTextBufferRemoveTag obj cb SignalConnectBefore
afterTextBufferRemoveTag :: (GObject a, MonadIO m) => a -> TextBufferRemoveTagCallback -> m SignalHandlerId
afterTextBufferRemoveTag obj cb = connectTextBufferRemoveTag obj cb SignalConnectAfter

connectTextBufferRemoveTag :: (GObject a, MonadIO m) =>
                              a -> TextBufferRemoveTagCallback -> SignalConnectMode -> m SignalHandlerId
connectTextBufferRemoveTag obj cb after = liftIO $ do
    cb' <- mkTextBufferRemoveTagCallback (textBufferRemoveTagCallbackWrapper cb)
    connectSignalFunPtr obj "remove-tag" cb' after

-- VVV Prop "copy-target-list"
   -- Type: TInterface "Gtk" "TargetList"
   -- Flags: [PropertyReadable]

getTextBufferCopyTargetList :: (MonadIO m, TextBufferK o) => o -> m TargetList
getTextBufferCopyTargetList obj = liftIO $ getObjectPropertyBoxed obj "copy-target-list" TargetList

data TextBufferCopyTargetListPropertyInfo
instance AttrInfo TextBufferCopyTargetListPropertyInfo where
    type AttrAllowedOps TextBufferCopyTargetListPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TextBufferCopyTargetListPropertyInfo = (~) ()
    type AttrBaseTypeConstraint TextBufferCopyTargetListPropertyInfo = TextBufferK
    type AttrGetType TextBufferCopyTargetListPropertyInfo = TargetList
    type AttrLabel TextBufferCopyTargetListPropertyInfo = "TextBuffer::copy-target-list"
    attrGet _ = getTextBufferCopyTargetList
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "cursor-position"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable]

getTextBufferCursorPosition :: (MonadIO m, TextBufferK o) => o -> m Int32
getTextBufferCursorPosition obj = liftIO $ getObjectPropertyCInt obj "cursor-position"

data TextBufferCursorPositionPropertyInfo
instance AttrInfo TextBufferCursorPositionPropertyInfo where
    type AttrAllowedOps TextBufferCursorPositionPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TextBufferCursorPositionPropertyInfo = (~) ()
    type AttrBaseTypeConstraint TextBufferCursorPositionPropertyInfo = TextBufferK
    type AttrGetType TextBufferCursorPositionPropertyInfo = Int32
    type AttrLabel TextBufferCursorPositionPropertyInfo = "TextBuffer::cursor-position"
    attrGet _ = getTextBufferCursorPosition
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "has-selection"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]

getTextBufferHasSelection :: (MonadIO m, TextBufferK o) => o -> m Bool
getTextBufferHasSelection obj = liftIO $ getObjectPropertyBool obj "has-selection"

data TextBufferHasSelectionPropertyInfo
instance AttrInfo TextBufferHasSelectionPropertyInfo where
    type AttrAllowedOps TextBufferHasSelectionPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TextBufferHasSelectionPropertyInfo = (~) ()
    type AttrBaseTypeConstraint TextBufferHasSelectionPropertyInfo = TextBufferK
    type AttrGetType TextBufferHasSelectionPropertyInfo = Bool
    type AttrLabel TextBufferHasSelectionPropertyInfo = "TextBuffer::has-selection"
    attrGet _ = getTextBufferHasSelection
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "paste-target-list"
   -- Type: TInterface "Gtk" "TargetList"
   -- Flags: [PropertyReadable]

getTextBufferPasteTargetList :: (MonadIO m, TextBufferK o) => o -> m TargetList
getTextBufferPasteTargetList obj = liftIO $ getObjectPropertyBoxed obj "paste-target-list" TargetList

data TextBufferPasteTargetListPropertyInfo
instance AttrInfo TextBufferPasteTargetListPropertyInfo where
    type AttrAllowedOps TextBufferPasteTargetListPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TextBufferPasteTargetListPropertyInfo = (~) ()
    type AttrBaseTypeConstraint TextBufferPasteTargetListPropertyInfo = TextBufferK
    type AttrGetType TextBufferPasteTargetListPropertyInfo = TargetList
    type AttrLabel TextBufferPasteTargetListPropertyInfo = "TextBuffer::paste-target-list"
    attrGet _ = getTextBufferPasteTargetList
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "tag-table"
   -- Type: TInterface "Gtk" "TextTagTable"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getTextBufferTagTable :: (MonadIO m, TextBufferK o) => o -> m TextTagTable
getTextBufferTagTable obj = liftIO $ getObjectPropertyObject obj "tag-table" TextTagTable

constructTextBufferTagTable :: (TextTagTableK a) => a -> IO ([Char], GValue)
constructTextBufferTagTable val = constructObjectPropertyObject "tag-table" val

data TextBufferTagTablePropertyInfo
instance AttrInfo TextBufferTagTablePropertyInfo where
    type AttrAllowedOps TextBufferTagTablePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TextBufferTagTablePropertyInfo = TextTagTableK
    type AttrBaseTypeConstraint TextBufferTagTablePropertyInfo = TextBufferK
    type AttrGetType TextBufferTagTablePropertyInfo = TextTagTable
    type AttrLabel TextBufferTagTablePropertyInfo = "TextBuffer::tag-table"
    attrGet _ = getTextBufferTagTable
    attrSet _ = undefined
    attrConstruct _ = constructTextBufferTagTable

-- VVV Prop "text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getTextBufferText :: (MonadIO m, TextBufferK o) => o -> m T.Text
getTextBufferText obj = liftIO $ getObjectPropertyString obj "text"

setTextBufferText :: (MonadIO m, TextBufferK o) => o -> T.Text -> m ()
setTextBufferText obj val = liftIO $ setObjectPropertyString obj "text" val

constructTextBufferText :: T.Text -> IO ([Char], GValue)
constructTextBufferText val = constructObjectPropertyString "text" val

data TextBufferTextPropertyInfo
instance AttrInfo TextBufferTextPropertyInfo where
    type AttrAllowedOps TextBufferTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TextBufferTextPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint TextBufferTextPropertyInfo = TextBufferK
    type AttrGetType TextBufferTextPropertyInfo = T.Text
    type AttrLabel TextBufferTextPropertyInfo = "TextBuffer::text"
    attrGet _ = getTextBufferText
    attrSet _ = setTextBufferText
    attrConstruct _ = constructTextBufferText

type instance AttributeList TextBuffer = TextBufferAttributeList
type TextBufferAttributeList = ('[ '("copy-target-list", TextBufferCopyTargetListPropertyInfo), '("cursor-position", TextBufferCursorPositionPropertyInfo), '("has-selection", TextBufferHasSelectionPropertyInfo), '("paste-target-list", TextBufferPasteTargetListPropertyInfo), '("tag-table", TextBufferTagTablePropertyInfo), '("text", TextBufferTextPropertyInfo)] :: [(Symbol, *)])

data TextBufferApplyTagSignalInfo
instance SignalInfo TextBufferApplyTagSignalInfo where
    type HaskellCallbackType TextBufferApplyTagSignalInfo = TextBufferApplyTagCallback
    connectSignal _ = connectTextBufferApplyTag

data TextBufferBeginUserActionSignalInfo
instance SignalInfo TextBufferBeginUserActionSignalInfo where
    type HaskellCallbackType TextBufferBeginUserActionSignalInfo = TextBufferBeginUserActionCallback
    connectSignal _ = connectTextBufferBeginUserAction

data TextBufferChangedSignalInfo
instance SignalInfo TextBufferChangedSignalInfo where
    type HaskellCallbackType TextBufferChangedSignalInfo = TextBufferChangedCallback
    connectSignal _ = connectTextBufferChanged

data TextBufferDeleteRangeSignalInfo
instance SignalInfo TextBufferDeleteRangeSignalInfo where
    type HaskellCallbackType TextBufferDeleteRangeSignalInfo = TextBufferDeleteRangeCallback
    connectSignal _ = connectTextBufferDeleteRange

data TextBufferEndUserActionSignalInfo
instance SignalInfo TextBufferEndUserActionSignalInfo where
    type HaskellCallbackType TextBufferEndUserActionSignalInfo = TextBufferEndUserActionCallback
    connectSignal _ = connectTextBufferEndUserAction

data TextBufferInsertChildAnchorSignalInfo
instance SignalInfo TextBufferInsertChildAnchorSignalInfo where
    type HaskellCallbackType TextBufferInsertChildAnchorSignalInfo = TextBufferInsertChildAnchorCallback
    connectSignal _ = connectTextBufferInsertChildAnchor

data TextBufferInsertPixbufSignalInfo
instance SignalInfo TextBufferInsertPixbufSignalInfo where
    type HaskellCallbackType TextBufferInsertPixbufSignalInfo = TextBufferInsertPixbufCallback
    connectSignal _ = connectTextBufferInsertPixbuf

data TextBufferInsertTextSignalInfo
instance SignalInfo TextBufferInsertTextSignalInfo where
    type HaskellCallbackType TextBufferInsertTextSignalInfo = TextBufferInsertTextCallback
    connectSignal _ = connectTextBufferInsertText

data TextBufferMarkDeletedSignalInfo
instance SignalInfo TextBufferMarkDeletedSignalInfo where
    type HaskellCallbackType TextBufferMarkDeletedSignalInfo = TextBufferMarkDeletedCallback
    connectSignal _ = connectTextBufferMarkDeleted

data TextBufferMarkSetSignalInfo
instance SignalInfo TextBufferMarkSetSignalInfo where
    type HaskellCallbackType TextBufferMarkSetSignalInfo = TextBufferMarkSetCallback
    connectSignal _ = connectTextBufferMarkSet

data TextBufferModifiedChangedSignalInfo
instance SignalInfo TextBufferModifiedChangedSignalInfo where
    type HaskellCallbackType TextBufferModifiedChangedSignalInfo = TextBufferModifiedChangedCallback
    connectSignal _ = connectTextBufferModifiedChanged

data TextBufferPasteDoneSignalInfo
instance SignalInfo TextBufferPasteDoneSignalInfo where
    type HaskellCallbackType TextBufferPasteDoneSignalInfo = TextBufferPasteDoneCallback
    connectSignal _ = connectTextBufferPasteDone

data TextBufferRemoveTagSignalInfo
instance SignalInfo TextBufferRemoveTagSignalInfo where
    type HaskellCallbackType TextBufferRemoveTagSignalInfo = TextBufferRemoveTagCallback
    connectSignal _ = connectTextBufferRemoveTag

type instance SignalList TextBuffer = TextBufferSignalList
type TextBufferSignalList = ('[ '("apply-tag", TextBufferApplyTagSignalInfo), '("begin-user-action", TextBufferBeginUserActionSignalInfo), '("changed", TextBufferChangedSignalInfo), '("delete-range", TextBufferDeleteRangeSignalInfo), '("end-user-action", TextBufferEndUserActionSignalInfo), '("insert-child-anchor", TextBufferInsertChildAnchorSignalInfo), '("insert-pixbuf", TextBufferInsertPixbufSignalInfo), '("insert-text", TextBufferInsertTextSignalInfo), '("mark-deleted", TextBufferMarkDeletedSignalInfo), '("mark-set", TextBufferMarkSetSignalInfo), '("modified-changed", TextBufferModifiedChangedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("paste-done", TextBufferPasteDoneSignalInfo), '("remove-tag", TextBufferRemoveTagSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method TextBuffer::new
-- method type : Constructor
-- Args : [Arg {argName = "table", argType = TInterface "Gtk" "TextTagTable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "table", argType = TInterface "Gtk" "TextTagTable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "TextBuffer"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_new" gtk_text_buffer_new :: 
    Ptr TextTagTable ->                     -- table : TInterface "Gtk" "TextTagTable"
    IO (Ptr TextBuffer)


textBufferNew ::
    (MonadIO m, TextTagTableK a) =>
    Maybe (a) ->                            -- table
    m TextBuffer
textBufferNew table = liftIO $ do
    maybeTable <- case table of
        Nothing -> return nullPtr
        Just jTable -> do
            let jTable' = unsafeManagedPtrCastPtr jTable
            return jTable'
    result <- gtk_text_buffer_new maybeTable
    checkUnexpectedReturnNULL "gtk_text_buffer_new" result
    result' <- (wrapObject TextBuffer) result
    whenJust table touchManagedPtr
    return result'

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

foreign import ccall "gtk_text_buffer_add_mark" gtk_text_buffer_add_mark :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextMark ->                         -- mark : TInterface "Gtk" "TextMark"
    Ptr TextIter ->                         -- where : TInterface "Gtk" "TextIter"
    IO ()


textBufferAddMark ::
    (MonadIO m, TextBufferK a, TextMarkK b) =>
    a ->                                    -- _obj
    b ->                                    -- mark
    TextIter ->                             -- where
    m ()
textBufferAddMark _obj mark where_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let mark' = unsafeManagedPtrCastPtr mark
    let where_' = unsafeManagedPtrGetPtr where_
    gtk_text_buffer_add_mark _obj' mark' where_'
    touchManagedPtr _obj
    touchManagedPtr mark
    touchManagedPtr where_
    return ()

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

foreign import ccall "gtk_text_buffer_add_selection_clipboard" gtk_text_buffer_add_selection_clipboard :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Clipboard ->                        -- clipboard : TInterface "Gtk" "Clipboard"
    IO ()


textBufferAddSelectionClipboard ::
    (MonadIO m, TextBufferK a, ClipboardK b) =>
    a ->                                    -- _obj
    b ->                                    -- clipboard
    m ()
textBufferAddSelectionClipboard _obj clipboard = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let clipboard' = unsafeManagedPtrCastPtr clipboard
    gtk_text_buffer_add_selection_clipboard _obj' clipboard'
    touchManagedPtr _obj
    touchManagedPtr clipboard
    return ()

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

foreign import ccall "gtk_text_buffer_apply_tag" gtk_text_buffer_apply_tag :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextTag ->                          -- tag : TInterface "Gtk" "TextTag"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    IO ()


textBufferApplyTag ::
    (MonadIO m, TextBufferK a, TextTagK b) =>
    a ->                                    -- _obj
    b ->                                    -- tag
    TextIter ->                             -- start
    TextIter ->                             -- end
    m ()
textBufferApplyTag _obj tag start end = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let tag' = unsafeManagedPtrCastPtr tag
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    gtk_text_buffer_apply_tag _obj' tag' start' end'
    touchManagedPtr _obj
    touchManagedPtr tag
    touchManagedPtr start
    touchManagedPtr end
    return ()

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

foreign import ccall "gtk_text_buffer_apply_tag_by_name" gtk_text_buffer_apply_tag_by_name :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- name : TBasicType TUTF8
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    IO ()


textBufferApplyTagByName ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- name
    TextIter ->                             -- start
    TextIter ->                             -- end
    m ()
textBufferApplyTagByName _obj name start end = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    name' <- textToCString name
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    gtk_text_buffer_apply_tag_by_name _obj' name' start' end'
    touchManagedPtr _obj
    touchManagedPtr start
    touchManagedPtr end
    freeMem name'
    return ()

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

foreign import ccall "gtk_text_buffer_backspace" gtk_text_buffer_backspace :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    CInt ->                                 -- interactive : TBasicType TBoolean
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO CInt


textBufferBackspace ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- iter
    Bool ->                                 -- interactive
    Bool ->                                 -- default_editable
    m Bool
textBufferBackspace _obj iter interactive default_editable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let iter' = unsafeManagedPtrGetPtr iter
    let interactive' = (fromIntegral . fromEnum) interactive
    let default_editable' = (fromIntegral . fromEnum) default_editable
    result <- gtk_text_buffer_backspace _obj' iter' interactive' default_editable'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr iter
    return result'

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

foreign import ccall "gtk_text_buffer_begin_user_action" gtk_text_buffer_begin_user_action :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO ()


textBufferBeginUserAction ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m ()
textBufferBeginUserAction _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_text_buffer_begin_user_action _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_text_buffer_copy_clipboard" gtk_text_buffer_copy_clipboard :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Clipboard ->                        -- clipboard : TInterface "Gtk" "Clipboard"
    IO ()


textBufferCopyClipboard ::
    (MonadIO m, TextBufferK a, ClipboardK b) =>
    a ->                                    -- _obj
    b ->                                    -- clipboard
    m ()
textBufferCopyClipboard _obj clipboard = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let clipboard' = unsafeManagedPtrCastPtr clipboard
    gtk_text_buffer_copy_clipboard _obj' clipboard'
    touchManagedPtr _obj
    touchManagedPtr clipboard
    return ()

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

foreign import ccall "gtk_text_buffer_create_child_anchor" gtk_text_buffer_create_child_anchor :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    IO (Ptr TextChildAnchor)


textBufferCreateChildAnchor ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- iter
    m TextChildAnchor
textBufferCreateChildAnchor _obj iter = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let iter' = unsafeManagedPtrGetPtr iter
    result <- gtk_text_buffer_create_child_anchor _obj' iter'
    checkUnexpectedReturnNULL "gtk_text_buffer_create_child_anchor" result
    result' <- (newObject TextChildAnchor) result
    touchManagedPtr _obj
    touchManagedPtr iter
    return result'

-- method TextBuffer::create_mark
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mark_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "where", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "left_gravity", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mark_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "where", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "left_gravity", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "TextMark"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_create_mark" gtk_text_buffer_create_mark :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- mark_name : TBasicType TUTF8
    Ptr TextIter ->                         -- where : TInterface "Gtk" "TextIter"
    CInt ->                                 -- left_gravity : TBasicType TBoolean
    IO (Ptr TextMark)


textBufferCreateMark ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Maybe (T.Text) ->                       -- mark_name
    TextIter ->                             -- where
    Bool ->                                 -- left_gravity
    m TextMark
textBufferCreateMark _obj mark_name where_ left_gravity = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeMark_name <- case mark_name of
        Nothing -> return nullPtr
        Just jMark_name -> do
            jMark_name' <- textToCString jMark_name
            return jMark_name'
    let where_' = unsafeManagedPtrGetPtr where_
    let left_gravity' = (fromIntegral . fromEnum) left_gravity
    result <- gtk_text_buffer_create_mark _obj' maybeMark_name where_' left_gravity'
    checkUnexpectedReturnNULL "gtk_text_buffer_create_mark" result
    result' <- (newObject TextMark) result
    touchManagedPtr _obj
    touchManagedPtr where_
    freeMem maybeMark_name
    return result'

-- method TextBuffer::cut_clipboard
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "clipboard", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_editable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "clipboard", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_editable", 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_text_buffer_cut_clipboard" gtk_text_buffer_cut_clipboard :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Clipboard ->                        -- clipboard : TInterface "Gtk" "Clipboard"
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO ()


textBufferCutClipboard ::
    (MonadIO m, TextBufferK a, ClipboardK b) =>
    a ->                                    -- _obj
    b ->                                    -- clipboard
    Bool ->                                 -- default_editable
    m ()
textBufferCutClipboard _obj clipboard default_editable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let clipboard' = unsafeManagedPtrCastPtr clipboard
    let default_editable' = (fromIntegral . fromEnum) default_editable
    gtk_text_buffer_cut_clipboard _obj' clipboard' default_editable'
    touchManagedPtr _obj
    touchManagedPtr clipboard
    return ()

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

foreign import ccall "gtk_text_buffer_delete" gtk_text_buffer_delete :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    IO ()


textBufferDelete ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- start
    TextIter ->                             -- end
    m ()
textBufferDelete _obj start end = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    gtk_text_buffer_delete _obj' start' end'
    touchManagedPtr _obj
    touchManagedPtr start
    touchManagedPtr end
    return ()

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

foreign import ccall "gtk_text_buffer_delete_interactive" gtk_text_buffer_delete_interactive :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- start_iter : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end_iter : TInterface "Gtk" "TextIter"
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO CInt


textBufferDeleteInteractive ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- start_iter
    TextIter ->                             -- end_iter
    Bool ->                                 -- default_editable
    m Bool
textBufferDeleteInteractive _obj start_iter end_iter default_editable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let start_iter' = unsafeManagedPtrGetPtr start_iter
    let end_iter' = unsafeManagedPtrGetPtr end_iter
    let default_editable' = (fromIntegral . fromEnum) default_editable
    result <- gtk_text_buffer_delete_interactive _obj' start_iter' end_iter' default_editable'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr start_iter
    touchManagedPtr end_iter
    return result'

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

foreign import ccall "gtk_text_buffer_delete_mark" gtk_text_buffer_delete_mark :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextMark ->                         -- mark : TInterface "Gtk" "TextMark"
    IO ()


textBufferDeleteMark ::
    (MonadIO m, TextBufferK a, TextMarkK b) =>
    a ->                                    -- _obj
    b ->                                    -- mark
    m ()
textBufferDeleteMark _obj mark = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let mark' = unsafeManagedPtrCastPtr mark
    gtk_text_buffer_delete_mark _obj' mark'
    touchManagedPtr _obj
    touchManagedPtr mark
    return ()

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

foreign import ccall "gtk_text_buffer_delete_mark_by_name" gtk_text_buffer_delete_mark_by_name :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- name : TBasicType TUTF8
    IO ()


textBufferDeleteMarkByName ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- name
    m ()
textBufferDeleteMarkByName _obj name = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    name' <- textToCString name
    gtk_text_buffer_delete_mark_by_name _obj' name'
    touchManagedPtr _obj
    freeMem name'
    return ()

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

foreign import ccall "gtk_text_buffer_delete_selection" gtk_text_buffer_delete_selection :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CInt ->                                 -- interactive : TBasicType TBoolean
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO CInt


textBufferDeleteSelection ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- interactive
    Bool ->                                 -- default_editable
    m Bool
textBufferDeleteSelection _obj interactive default_editable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let interactive' = (fromIntegral . fromEnum) interactive
    let default_editable' = (fromIntegral . fromEnum) default_editable
    result <- gtk_text_buffer_delete_selection _obj' interactive' default_editable'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method TextBuffer::deserialize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_buffer", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 5 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_buffer", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 5 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : True
-- Skip return : False

foreign import ccall "gtk_text_buffer_deserialize" gtk_text_buffer_deserialize :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextBuffer ->                       -- content_buffer : TInterface "Gtk" "TextBuffer"
    Ptr Gdk.Atom ->                         -- format : TInterface "Gdk" "Atom"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Ptr Word8 ->                            -- data : TCArray False (-1) 5 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CInt


textBufferDeserialize ::
    (MonadIO m, TextBufferK a, TextBufferK b) =>
    a ->                                    -- _obj
    b ->                                    -- content_buffer
    Gdk.Atom ->                             -- format
    TextIter ->                             -- iter
    ByteString ->                           -- data
    m ()
textBufferDeserialize _obj content_buffer format iter data_ = liftIO $ do
    let length_ = fromIntegral $ B.length data_
    let _obj' = unsafeManagedPtrCastPtr _obj
    let content_buffer' = unsafeManagedPtrCastPtr content_buffer
    let format' = unsafeManagedPtrGetPtr format
    let iter' = unsafeManagedPtrGetPtr iter
    data_' <- packByteString data_
    onException (do
        _ <- propagateGError $ gtk_text_buffer_deserialize _obj' content_buffer' format' iter' data_' length_
        touchManagedPtr _obj
        touchManagedPtr content_buffer
        touchManagedPtr format
        touchManagedPtr iter
        freeMem data_'
        return ()
     ) (do
        freeMem data_'
     )

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

foreign import ccall "gtk_text_buffer_deserialize_get_can_create_tags" gtk_text_buffer_deserialize_get_can_create_tags :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Gdk.Atom ->                         -- format : TInterface "Gdk" "Atom"
    IO CInt


textBufferDeserializeGetCanCreateTags ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Gdk.Atom ->                             -- format
    m Bool
textBufferDeserializeGetCanCreateTags _obj format = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let format' = unsafeManagedPtrGetPtr format
    result <- gtk_text_buffer_deserialize_get_can_create_tags _obj' format'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr format
    return result'

-- method TextBuffer::deserialize_set_can_create_tags
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "can_create_tags", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "can_create_tags", 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_text_buffer_deserialize_set_can_create_tags" gtk_text_buffer_deserialize_set_can_create_tags :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Gdk.Atom ->                         -- format : TInterface "Gdk" "Atom"
    CInt ->                                 -- can_create_tags : TBasicType TBoolean
    IO ()


textBufferDeserializeSetCanCreateTags ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Gdk.Atom ->                             -- format
    Bool ->                                 -- can_create_tags
    m ()
textBufferDeserializeSetCanCreateTags _obj format can_create_tags = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let format' = unsafeManagedPtrGetPtr format
    let can_create_tags' = (fromIntegral . fromEnum) can_create_tags
    gtk_text_buffer_deserialize_set_can_create_tags _obj' format' can_create_tags'
    touchManagedPtr _obj
    touchManagedPtr format
    return ()

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

foreign import ccall "gtk_text_buffer_end_user_action" gtk_text_buffer_end_user_action :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO ()


textBufferEndUserAction ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m ()
textBufferEndUserAction _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_text_buffer_end_user_action _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_text_buffer_get_bounds" gtk_text_buffer_get_bounds :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    IO ()


textBufferGetBounds ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m (TextIter,TextIter)
textBufferGetBounds _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    start <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    end <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    gtk_text_buffer_get_bounds _obj' start end
    start' <- (wrapBoxed TextIter) start
    end' <- (wrapBoxed TextIter) end
    touchManagedPtr _obj
    return (start', end')

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

foreign import ccall "gtk_text_buffer_get_char_count" gtk_text_buffer_get_char_count :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO Int32


textBufferGetCharCount ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m Int32
textBufferGetCharCount _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_text_buffer_get_char_count _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "gtk_text_buffer_get_copy_target_list" gtk_text_buffer_get_copy_target_list :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO (Ptr TargetList)


textBufferGetCopyTargetList ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m TargetList
textBufferGetCopyTargetList _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_text_buffer_get_copy_target_list _obj'
    checkUnexpectedReturnNULL "gtk_text_buffer_get_copy_target_list" result
    result' <- (newBoxed TargetList) result
    touchManagedPtr _obj
    return result'

-- method TextBuffer::get_deserialize_formats
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_formats", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : [Arg {argName = "n_formats", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TCArray False (-1) 1 (TInterface "Gdk" "Atom")
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_get_deserialize_formats" gtk_text_buffer_get_deserialize_formats :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Int32 ->                            -- n_formats : TBasicType TInt32
    IO (Ptr (Ptr Gdk.Atom))


textBufferGetDeserializeFormats ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m [Gdk.Atom]
textBufferGetDeserializeFormats _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    n_formats <- allocMem :: IO (Ptr Int32)
    result <- gtk_text_buffer_get_deserialize_formats _obj' n_formats
    n_formats' <- peek n_formats
    checkUnexpectedReturnNULL "gtk_text_buffer_get_deserialize_formats" result
    -- XXX Wrapping a foreign struct/union with no known destructor, leak?
    result' <- (unpackPtrArrayWithLength n_formats') result
    result'' <- mapM (\x -> Gdk.Atom <$> newForeignPtr_ x) result'
    freeMem result
    touchManagedPtr _obj
    freeMem n_formats
    return result''

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

foreign import ccall "gtk_text_buffer_get_end_iter" gtk_text_buffer_get_end_iter :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    IO ()


textBufferGetEndIter ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m (TextIter)
textBufferGetEndIter _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    iter <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    gtk_text_buffer_get_end_iter _obj' iter
    iter' <- (wrapBoxed TextIter) iter
    touchManagedPtr _obj
    return iter'

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

foreign import ccall "gtk_text_buffer_get_has_selection" gtk_text_buffer_get_has_selection :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO CInt


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

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

foreign import ccall "gtk_text_buffer_get_insert" gtk_text_buffer_get_insert :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO (Ptr TextMark)


textBufferGetInsert ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m TextMark
textBufferGetInsert _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_text_buffer_get_insert _obj'
    checkUnexpectedReturnNULL "gtk_text_buffer_get_insert" result
    result' <- (newObject TextMark) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_text_buffer_get_iter_at_child_anchor" gtk_text_buffer_get_iter_at_child_anchor :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Ptr TextChildAnchor ->                  -- anchor : TInterface "Gtk" "TextChildAnchor"
    IO ()


textBufferGetIterAtChildAnchor ::
    (MonadIO m, TextBufferK a, TextChildAnchorK b) =>
    a ->                                    -- _obj
    b ->                                    -- anchor
    m (TextIter)
textBufferGetIterAtChildAnchor _obj anchor = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    iter <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    let anchor' = unsafeManagedPtrCastPtr anchor
    gtk_text_buffer_get_iter_at_child_anchor _obj' iter anchor'
    iter' <- (wrapBoxed TextIter) iter
    touchManagedPtr _obj
    touchManagedPtr anchor
    return iter'

-- method TextBuffer::get_iter_at_line
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line_number", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line_number", 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_text_buffer_get_iter_at_line" gtk_text_buffer_get_iter_at_line :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Int32 ->                                -- line_number : TBasicType TInt32
    IO ()


textBufferGetIterAtLine ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- line_number
    m (TextIter)
textBufferGetIterAtLine _obj line_number = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    iter <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    gtk_text_buffer_get_iter_at_line _obj' iter line_number
    iter' <- (wrapBoxed TextIter) iter
    touchManagedPtr _obj
    return iter'

-- method TextBuffer::get_iter_at_line_index
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line_number", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "byte_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line_number", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "byte_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_text_buffer_get_iter_at_line_index" gtk_text_buffer_get_iter_at_line_index :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Int32 ->                                -- line_number : TBasicType TInt32
    Int32 ->                                -- byte_index : TBasicType TInt32
    IO ()


textBufferGetIterAtLineIndex ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- line_number
    Int32 ->                                -- byte_index
    m (TextIter)
textBufferGetIterAtLineIndex _obj line_number byte_index = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    iter <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    gtk_text_buffer_get_iter_at_line_index _obj' iter line_number byte_index
    iter' <- (wrapBoxed TextIter) iter
    touchManagedPtr _obj
    return iter'

-- method TextBuffer::get_iter_at_line_offset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line_number", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "char_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line_number", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "char_offset", 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_text_buffer_get_iter_at_line_offset" gtk_text_buffer_get_iter_at_line_offset :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Int32 ->                                -- line_number : TBasicType TInt32
    Int32 ->                                -- char_offset : TBasicType TInt32
    IO ()


textBufferGetIterAtLineOffset ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- line_number
    Int32 ->                                -- char_offset
    m (TextIter)
textBufferGetIterAtLineOffset _obj line_number char_offset = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    iter <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    gtk_text_buffer_get_iter_at_line_offset _obj' iter line_number char_offset
    iter' <- (wrapBoxed TextIter) iter
    touchManagedPtr _obj
    return iter'

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

foreign import ccall "gtk_text_buffer_get_iter_at_mark" gtk_text_buffer_get_iter_at_mark :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Ptr TextMark ->                         -- mark : TInterface "Gtk" "TextMark"
    IO ()


textBufferGetIterAtMark ::
    (MonadIO m, TextBufferK a, TextMarkK b) =>
    a ->                                    -- _obj
    b ->                                    -- mark
    m (TextIter)
textBufferGetIterAtMark _obj mark = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    iter <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    let mark' = unsafeManagedPtrCastPtr mark
    gtk_text_buffer_get_iter_at_mark _obj' iter mark'
    iter' <- (wrapBoxed TextIter) iter
    touchManagedPtr _obj
    touchManagedPtr mark
    return iter'

-- method TextBuffer::get_iter_at_offset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "char_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "char_offset", 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_text_buffer_get_iter_at_offset" gtk_text_buffer_get_iter_at_offset :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Int32 ->                                -- char_offset : TBasicType TInt32
    IO ()


textBufferGetIterAtOffset ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- char_offset
    m (TextIter)
textBufferGetIterAtOffset _obj char_offset = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    iter <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    gtk_text_buffer_get_iter_at_offset _obj' iter char_offset
    iter' <- (wrapBoxed TextIter) iter
    touchManagedPtr _obj
    return iter'

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

foreign import ccall "gtk_text_buffer_get_line_count" gtk_text_buffer_get_line_count :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO Int32


textBufferGetLineCount ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m Int32
textBufferGetLineCount _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_text_buffer_get_line_count _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "gtk_text_buffer_get_mark" gtk_text_buffer_get_mark :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr TextMark)


textBufferGetMark ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- name
    m TextMark
textBufferGetMark _obj name = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    name' <- textToCString name
    result <- gtk_text_buffer_get_mark _obj' name'
    checkUnexpectedReturnNULL "gtk_text_buffer_get_mark" result
    result' <- (newObject TextMark) result
    touchManagedPtr _obj
    freeMem name'
    return result'

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

foreign import ccall "gtk_text_buffer_get_modified" gtk_text_buffer_get_modified :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO CInt


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

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

foreign import ccall "gtk_text_buffer_get_paste_target_list" gtk_text_buffer_get_paste_target_list :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO (Ptr TargetList)


textBufferGetPasteTargetList ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m TargetList
textBufferGetPasteTargetList _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_text_buffer_get_paste_target_list _obj'
    checkUnexpectedReturnNULL "gtk_text_buffer_get_paste_target_list" result
    result' <- (newBoxed TargetList) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_text_buffer_get_selection_bound" gtk_text_buffer_get_selection_bound :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO (Ptr TextMark)


textBufferGetSelectionBound ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m TextMark
textBufferGetSelectionBound _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_text_buffer_get_selection_bound _obj'
    checkUnexpectedReturnNULL "gtk_text_buffer_get_selection_bound" result
    result' <- (newObject TextMark) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_text_buffer_get_selection_bounds" gtk_text_buffer_get_selection_bounds :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    IO CInt


textBufferGetSelectionBounds ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m (Bool,TextIter,TextIter)
textBufferGetSelectionBounds _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    start <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    end <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    result <- gtk_text_buffer_get_selection_bounds _obj' start end
    let result' = (/= 0) result
    start' <- (wrapBoxed TextIter) start
    end' <- (wrapBoxed TextIter) end
    touchManagedPtr _obj
    return (result', start', end')

-- method TextBuffer::get_serialize_formats
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_formats", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : [Arg {argName = "n_formats", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TCArray False (-1) 1 (TInterface "Gdk" "Atom")
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_get_serialize_formats" gtk_text_buffer_get_serialize_formats :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Int32 ->                            -- n_formats : TBasicType TInt32
    IO (Ptr (Ptr Gdk.Atom))


textBufferGetSerializeFormats ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m [Gdk.Atom]
textBufferGetSerializeFormats _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    n_formats <- allocMem :: IO (Ptr Int32)
    result <- gtk_text_buffer_get_serialize_formats _obj' n_formats
    n_formats' <- peek n_formats
    checkUnexpectedReturnNULL "gtk_text_buffer_get_serialize_formats" result
    -- XXX Wrapping a foreign struct/union with no known destructor, leak?
    result' <- (unpackPtrArrayWithLength n_formats') result
    result'' <- mapM (\x -> Gdk.Atom <$> newForeignPtr_ x) result'
    freeMem result
    touchManagedPtr _obj
    freeMem n_formats
    return result''

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

foreign import ccall "gtk_text_buffer_get_slice" gtk_text_buffer_get_slice :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    CInt ->                                 -- include_hidden_chars : TBasicType TBoolean
    IO CString


textBufferGetSlice ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- start
    TextIter ->                             -- end
    Bool ->                                 -- include_hidden_chars
    m T.Text
textBufferGetSlice _obj start end include_hidden_chars = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    let include_hidden_chars' = (fromIntegral . fromEnum) include_hidden_chars
    result <- gtk_text_buffer_get_slice _obj' start' end' include_hidden_chars'
    checkUnexpectedReturnNULL "gtk_text_buffer_get_slice" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    touchManagedPtr start
    touchManagedPtr end
    return result'

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

foreign import ccall "gtk_text_buffer_get_start_iter" gtk_text_buffer_get_start_iter :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    IO ()


textBufferGetStartIter ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m (TextIter)
textBufferGetStartIter _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    iter <- callocBoxedBytes 80 :: IO (Ptr TextIter)
    gtk_text_buffer_get_start_iter _obj' iter
    iter' <- (wrapBoxed TextIter) iter
    touchManagedPtr _obj
    return iter'

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

foreign import ccall "gtk_text_buffer_get_tag_table" gtk_text_buffer_get_tag_table :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    IO (Ptr TextTagTable)


textBufferGetTagTable ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    m TextTagTable
textBufferGetTagTable _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_text_buffer_get_tag_table _obj'
    checkUnexpectedReturnNULL "gtk_text_buffer_get_tag_table" result
    result' <- (newObject TextTagTable) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_text_buffer_get_text" gtk_text_buffer_get_text :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    CInt ->                                 -- include_hidden_chars : TBasicType TBoolean
    IO CString


textBufferGetText ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- start
    TextIter ->                             -- end
    Bool ->                                 -- include_hidden_chars
    m T.Text
textBufferGetText _obj start end include_hidden_chars = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    let include_hidden_chars' = (fromIntegral . fromEnum) include_hidden_chars
    result <- gtk_text_buffer_get_text _obj' start' end' include_hidden_chars'
    checkUnexpectedReturnNULL "gtk_text_buffer_get_text" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    touchManagedPtr start
    touchManagedPtr end
    return result'

-- method TextBuffer::insert
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", 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}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", 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}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_insert" gtk_text_buffer_insert :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    CString ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- len : TBasicType TInt32
    IO ()


textBufferInsert ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- iter
    T.Text ->                               -- text
    Int32 ->                                -- len
    m ()
textBufferInsert _obj iter text len = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let iter' = unsafeManagedPtrGetPtr iter
    text' <- textToCString text
    gtk_text_buffer_insert _obj' iter' text' len
    touchManagedPtr _obj
    touchManagedPtr iter
    freeMem text'
    return ()

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

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


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

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

foreign import ccall "gtk_text_buffer_insert_child_anchor" gtk_text_buffer_insert_child_anchor :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Ptr TextChildAnchor ->                  -- anchor : TInterface "Gtk" "TextChildAnchor"
    IO ()


textBufferInsertChildAnchor ::
    (MonadIO m, TextBufferK a, TextChildAnchorK b) =>
    a ->                                    -- _obj
    TextIter ->                             -- iter
    b ->                                    -- anchor
    m ()
textBufferInsertChildAnchor _obj iter anchor = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let iter' = unsafeManagedPtrGetPtr iter
    let anchor' = unsafeManagedPtrCastPtr anchor
    gtk_text_buffer_insert_child_anchor _obj' iter' anchor'
    touchManagedPtr _obj
    touchManagedPtr iter
    touchManagedPtr anchor
    return ()

-- method TextBuffer::insert_interactive
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", 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 = "default_editable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", 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 = "default_editable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_insert_interactive" gtk_text_buffer_insert_interactive :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    CString ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- len : TBasicType TInt32
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO CInt


textBufferInsertInteractive ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- iter
    T.Text ->                               -- text
    Int32 ->                                -- len
    Bool ->                                 -- default_editable
    m Bool
textBufferInsertInteractive _obj iter text len default_editable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let iter' = unsafeManagedPtrGetPtr iter
    text' <- textToCString text
    let default_editable' = (fromIntegral . fromEnum) default_editable
    result <- gtk_text_buffer_insert_interactive _obj' iter' text' len default_editable'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr iter
    freeMem text'
    return result'

-- method TextBuffer::insert_interactive_at_cursor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", 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 = "default_editable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", 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 = "default_editable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_insert_interactive_at_cursor" gtk_text_buffer_insert_interactive_at_cursor :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- len : TBasicType TInt32
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO CInt


textBufferInsertInteractiveAtCursor ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- text
    Int32 ->                                -- len
    Bool ->                                 -- default_editable
    m Bool
textBufferInsertInteractiveAtCursor _obj text len default_editable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    text' <- textToCString text
    let default_editable' = (fromIntegral . fromEnum) default_editable
    result <- gtk_text_buffer_insert_interactive_at_cursor _obj' text' len default_editable'
    let result' = (/= 0) result
    touchManagedPtr _obj
    freeMem text'
    return result'

-- method TextBuffer::insert_markup
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "markup", 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}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iter", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "markup", 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}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_insert_markup" gtk_text_buffer_insert_markup :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    CString ->                              -- markup : TBasicType TUTF8
    Int32 ->                                -- len : TBasicType TInt32
    IO ()


textBufferInsertMarkup ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- iter
    T.Text ->                               -- markup
    Int32 ->                                -- len
    m ()
textBufferInsertMarkup _obj iter markup len = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let iter' = unsafeManagedPtrGetPtr iter
    markup' <- textToCString markup
    gtk_text_buffer_insert_markup _obj' iter' markup' len
    touchManagedPtr _obj
    touchManagedPtr iter
    freeMem markup'
    return ()

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

foreign import ccall "gtk_text_buffer_insert_pixbuf" gtk_text_buffer_insert_pixbuf :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Ptr GdkPixbuf.Pixbuf ->                 -- pixbuf : TInterface "GdkPixbuf" "Pixbuf"
    IO ()


textBufferInsertPixbuf ::
    (MonadIO m, TextBufferK a, GdkPixbuf.PixbufK b) =>
    a ->                                    -- _obj
    TextIter ->                             -- iter
    b ->                                    -- pixbuf
    m ()
textBufferInsertPixbuf _obj iter pixbuf = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let iter' = unsafeManagedPtrGetPtr iter
    let pixbuf' = unsafeManagedPtrCastPtr pixbuf
    gtk_text_buffer_insert_pixbuf _obj' iter' pixbuf'
    touchManagedPtr _obj
    touchManagedPtr iter
    touchManagedPtr pixbuf
    return ()

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

foreign import ccall "gtk_text_buffer_insert_range" gtk_text_buffer_insert_range :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    IO ()


textBufferInsertRange ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- iter
    TextIter ->                             -- start
    TextIter ->                             -- end
    m ()
textBufferInsertRange _obj iter start end = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let iter' = unsafeManagedPtrGetPtr iter
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    gtk_text_buffer_insert_range _obj' iter' start' end'
    touchManagedPtr _obj
    touchManagedPtr iter
    touchManagedPtr start
    touchManagedPtr end
    return ()

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

foreign import ccall "gtk_text_buffer_insert_range_interactive" gtk_text_buffer_insert_range_interactive :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- iter : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO CInt


textBufferInsertRangeInteractive ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- iter
    TextIter ->                             -- start
    TextIter ->                             -- end
    Bool ->                                 -- default_editable
    m Bool
textBufferInsertRangeInteractive _obj iter start end default_editable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let iter' = unsafeManagedPtrGetPtr iter
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    let default_editable' = (fromIntegral . fromEnum) default_editable
    result <- gtk_text_buffer_insert_range_interactive _obj' iter' start' end' default_editable'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr iter
    touchManagedPtr start
    touchManagedPtr end
    return result'

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

foreign import ccall "gtk_text_buffer_move_mark" gtk_text_buffer_move_mark :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextMark ->                         -- mark : TInterface "Gtk" "TextMark"
    Ptr TextIter ->                         -- where : TInterface "Gtk" "TextIter"
    IO ()


textBufferMoveMark ::
    (MonadIO m, TextBufferK a, TextMarkK b) =>
    a ->                                    -- _obj
    b ->                                    -- mark
    TextIter ->                             -- where
    m ()
textBufferMoveMark _obj mark where_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let mark' = unsafeManagedPtrCastPtr mark
    let where_' = unsafeManagedPtrGetPtr where_
    gtk_text_buffer_move_mark _obj' mark' where_'
    touchManagedPtr _obj
    touchManagedPtr mark
    touchManagedPtr where_
    return ()

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

foreign import ccall "gtk_text_buffer_move_mark_by_name" gtk_text_buffer_move_mark_by_name :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- name : TBasicType TUTF8
    Ptr TextIter ->                         -- where : TInterface "Gtk" "TextIter"
    IO ()


textBufferMoveMarkByName ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- name
    TextIter ->                             -- where
    m ()
textBufferMoveMarkByName _obj name where_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    name' <- textToCString name
    let where_' = unsafeManagedPtrGetPtr where_
    gtk_text_buffer_move_mark_by_name _obj' name' where_'
    touchManagedPtr _obj
    touchManagedPtr where_
    freeMem name'
    return ()

-- method TextBuffer::paste_clipboard
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "clipboard", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "override_location", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_editable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "clipboard", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "override_location", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_editable", 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_text_buffer_paste_clipboard" gtk_text_buffer_paste_clipboard :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Clipboard ->                        -- clipboard : TInterface "Gtk" "Clipboard"
    Ptr TextIter ->                         -- override_location : TInterface "Gtk" "TextIter"
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO ()


textBufferPasteClipboard ::
    (MonadIO m, TextBufferK a, ClipboardK b) =>
    a ->                                    -- _obj
    b ->                                    -- clipboard
    Maybe (TextIter) ->                     -- override_location
    Bool ->                                 -- default_editable
    m ()
textBufferPasteClipboard _obj clipboard override_location default_editable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let clipboard' = unsafeManagedPtrCastPtr clipboard
    maybeOverride_location <- case override_location of
        Nothing -> return nullPtr
        Just jOverride_location -> do
            let jOverride_location' = unsafeManagedPtrGetPtr jOverride_location
            return jOverride_location'
    let default_editable' = (fromIntegral . fromEnum) default_editable
    gtk_text_buffer_paste_clipboard _obj' clipboard' maybeOverride_location default_editable'
    touchManagedPtr _obj
    touchManagedPtr clipboard
    whenJust override_location touchManagedPtr
    return ()

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

foreign import ccall "gtk_text_buffer_place_cursor" gtk_text_buffer_place_cursor :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- where : TInterface "Gtk" "TextIter"
    IO ()


textBufferPlaceCursor ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- where
    m ()
textBufferPlaceCursor _obj where_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let where_' = unsafeManagedPtrGetPtr where_
    gtk_text_buffer_place_cursor _obj' where_'
    touchManagedPtr _obj
    touchManagedPtr where_
    return ()

-- method TextBuffer::register_deserialize_format
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mime_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "Gtk" "TextBufferDeserializeFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mime_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "Gtk" "TextBufferDeserializeFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Atom"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_register_deserialize_format" gtk_text_buffer_register_deserialize_format :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- mime_type : TBasicType TUTF8
    FunPtr TextBufferDeserializeFuncC ->    -- function : TInterface "Gtk" "TextBufferDeserializeFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- user_data_destroy : TInterface "GLib" "DestroyNotify"
    IO (Ptr Gdk.Atom)


textBufferRegisterDeserializeFormat ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- mime_type
    TextBufferDeserializeFunc ->            -- function
    m Gdk.Atom
textBufferRegisterDeserializeFormat _obj mime_type function = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    mime_type' <- textToCString mime_type
    function' <- mkTextBufferDeserializeFunc (textBufferDeserializeFuncWrapper Nothing function)
    let user_data = castFunPtrToPtr function'
    let user_data_destroy = safeFreeFunPtrPtr
    result <- gtk_text_buffer_register_deserialize_format _obj' mime_type' function' user_data user_data_destroy
    checkUnexpectedReturnNULL "gtk_text_buffer_register_deserialize_format" result
    -- XXX Wrapping a foreign struct/union with no known destructor, leak?
    result' <- (\x -> Gdk.Atom <$> newForeignPtr_ x) result
    touchManagedPtr _obj
    freeMem mime_type'
    return result'

-- method TextBuffer::register_deserialize_tagset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tagset_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tagset_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Atom"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_register_deserialize_tagset" gtk_text_buffer_register_deserialize_tagset :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- tagset_name : TBasicType TUTF8
    IO (Ptr Gdk.Atom)


textBufferRegisterDeserializeTagset ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Maybe (T.Text) ->                       -- tagset_name
    m Gdk.Atom
textBufferRegisterDeserializeTagset _obj tagset_name = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeTagset_name <- case tagset_name of
        Nothing -> return nullPtr
        Just jTagset_name -> do
            jTagset_name' <- textToCString jTagset_name
            return jTagset_name'
    result <- gtk_text_buffer_register_deserialize_tagset _obj' maybeTagset_name
    checkUnexpectedReturnNULL "gtk_text_buffer_register_deserialize_tagset" result
    -- XXX Wrapping a foreign struct/union with no known destructor, leak?
    result' <- (\x -> Gdk.Atom <$> newForeignPtr_ x) result
    touchManagedPtr _obj
    freeMem maybeTagset_name
    return result'

-- method TextBuffer::register_serialize_format
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mime_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "Gtk" "TextBufferSerializeFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mime_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "Gtk" "TextBufferSerializeFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Atom"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_register_serialize_format" gtk_text_buffer_register_serialize_format :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- mime_type : TBasicType TUTF8
    FunPtr TextBufferSerializeFuncC ->      -- function : TInterface "Gtk" "TextBufferSerializeFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- user_data_destroy : TInterface "GLib" "DestroyNotify"
    IO (Ptr Gdk.Atom)


textBufferRegisterSerializeFormat ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- mime_type
    TextBufferSerializeFunc ->              -- function
    m Gdk.Atom
textBufferRegisterSerializeFormat _obj mime_type function = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    mime_type' <- textToCString mime_type
    function' <- mkTextBufferSerializeFunc (textBufferSerializeFuncWrapper Nothing function)
    let user_data = castFunPtrToPtr function'
    let user_data_destroy = safeFreeFunPtrPtr
    result <- gtk_text_buffer_register_serialize_format _obj' mime_type' function' user_data user_data_destroy
    checkUnexpectedReturnNULL "gtk_text_buffer_register_serialize_format" result
    -- XXX Wrapping a foreign struct/union with no known destructor, leak?
    result' <- (\x -> Gdk.Atom <$> newForeignPtr_ x) result
    touchManagedPtr _obj
    freeMem mime_type'
    return result'

-- method TextBuffer::register_serialize_tagset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tagset_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tagset_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Atom"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_register_serialize_tagset" gtk_text_buffer_register_serialize_tagset :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- tagset_name : TBasicType TUTF8
    IO (Ptr Gdk.Atom)


textBufferRegisterSerializeTagset ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Maybe (T.Text) ->                       -- tagset_name
    m Gdk.Atom
textBufferRegisterSerializeTagset _obj tagset_name = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeTagset_name <- case tagset_name of
        Nothing -> return nullPtr
        Just jTagset_name -> do
            jTagset_name' <- textToCString jTagset_name
            return jTagset_name'
    result <- gtk_text_buffer_register_serialize_tagset _obj' maybeTagset_name
    checkUnexpectedReturnNULL "gtk_text_buffer_register_serialize_tagset" result
    -- XXX Wrapping a foreign struct/union with no known destructor, leak?
    result' <- (\x -> Gdk.Atom <$> newForeignPtr_ x) result
    touchManagedPtr _obj
    freeMem maybeTagset_name
    return result'

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

foreign import ccall "gtk_text_buffer_remove_all_tags" gtk_text_buffer_remove_all_tags :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    IO ()


textBufferRemoveAllTags ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- start
    TextIter ->                             -- end
    m ()
textBufferRemoveAllTags _obj start end = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    gtk_text_buffer_remove_all_tags _obj' start' end'
    touchManagedPtr _obj
    touchManagedPtr start
    touchManagedPtr end
    return ()

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

foreign import ccall "gtk_text_buffer_remove_selection_clipboard" gtk_text_buffer_remove_selection_clipboard :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Clipboard ->                        -- clipboard : TInterface "Gtk" "Clipboard"
    IO ()


textBufferRemoveSelectionClipboard ::
    (MonadIO m, TextBufferK a, ClipboardK b) =>
    a ->                                    -- _obj
    b ->                                    -- clipboard
    m ()
textBufferRemoveSelectionClipboard _obj clipboard = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let clipboard' = unsafeManagedPtrCastPtr clipboard
    gtk_text_buffer_remove_selection_clipboard _obj' clipboard'
    touchManagedPtr _obj
    touchManagedPtr clipboard
    return ()

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

foreign import ccall "gtk_text_buffer_remove_tag" gtk_text_buffer_remove_tag :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextTag ->                          -- tag : TInterface "Gtk" "TextTag"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    IO ()


textBufferRemoveTag ::
    (MonadIO m, TextBufferK a, TextTagK b) =>
    a ->                                    -- _obj
    b ->                                    -- tag
    TextIter ->                             -- start
    TextIter ->                             -- end
    m ()
textBufferRemoveTag _obj tag start end = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let tag' = unsafeManagedPtrCastPtr tag
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    gtk_text_buffer_remove_tag _obj' tag' start' end'
    touchManagedPtr _obj
    touchManagedPtr tag
    touchManagedPtr start
    touchManagedPtr end
    return ()

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

foreign import ccall "gtk_text_buffer_remove_tag_by_name" gtk_text_buffer_remove_tag_by_name :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CString ->                              -- name : TBasicType TUTF8
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    IO ()


textBufferRemoveTagByName ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- name
    TextIter ->                             -- start
    TextIter ->                             -- end
    m ()
textBufferRemoveTagByName _obj name start end = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    name' <- textToCString name
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    gtk_text_buffer_remove_tag_by_name _obj' name' start' end'
    touchManagedPtr _obj
    touchManagedPtr start
    touchManagedPtr end
    freeMem name'
    return ()

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

foreign import ccall "gtk_text_buffer_select_range" gtk_text_buffer_select_range :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextIter ->                         -- ins : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- bound : TInterface "Gtk" "TextIter"
    IO ()


textBufferSelectRange ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    TextIter ->                             -- ins
    TextIter ->                             -- bound
    m ()
textBufferSelectRange _obj ins bound = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let ins' = unsafeManagedPtrGetPtr ins
    let bound' = unsafeManagedPtrGetPtr bound
    gtk_text_buffer_select_range _obj' ins' bound'
    touchManagedPtr _obj
    touchManagedPtr ins
    touchManagedPtr bound
    return ()

-- method TextBuffer::serialize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_buffer", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_buffer", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TInterface "Gtk" "TextIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TCArray False (-1) 5 (TBasicType TUInt8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_serialize" gtk_text_buffer_serialize :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr TextBuffer ->                       -- content_buffer : TInterface "Gtk" "TextBuffer"
    Ptr Gdk.Atom ->                         -- format : TInterface "Gdk" "Atom"
    Ptr TextIter ->                         -- start : TInterface "Gtk" "TextIter"
    Ptr TextIter ->                         -- end : TInterface "Gtk" "TextIter"
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO (Ptr Word8)


textBufferSerialize ::
    (MonadIO m, TextBufferK a, TextBufferK b) =>
    a ->                                    -- _obj
    b ->                                    -- content_buffer
    Gdk.Atom ->                             -- format
    TextIter ->                             -- start
    TextIter ->                             -- end
    m ByteString
textBufferSerialize _obj content_buffer format start end = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let content_buffer' = unsafeManagedPtrCastPtr content_buffer
    let format' = unsafeManagedPtrGetPtr format
    let start' = unsafeManagedPtrGetPtr start
    let end' = unsafeManagedPtrGetPtr end
    length_ <- allocMem :: IO (Ptr Word64)
    result <- gtk_text_buffer_serialize _obj' content_buffer' format' start' end' length_
    length_' <- peek length_
    checkUnexpectedReturnNULL "gtk_text_buffer_serialize" result
    result' <- (unpackByteStringWithLength length_') result
    freeMem result
    touchManagedPtr _obj
    touchManagedPtr content_buffer
    touchManagedPtr format
    touchManagedPtr start
    touchManagedPtr end
    freeMem length_
    return result'

-- method TextBuffer::set_modified
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", 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_text_buffer_set_modified" gtk_text_buffer_set_modified :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()


textBufferSetModified ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- setting
    m ()
textBufferSetModified _obj setting = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let setting' = (fromIntegral . fromEnum) setting
    gtk_text_buffer_set_modified _obj' setting'
    touchManagedPtr _obj
    return ()

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

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


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

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

foreign import ccall "gtk_text_buffer_unregister_deserialize_format" gtk_text_buffer_unregister_deserialize_format :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Gdk.Atom ->                         -- format : TInterface "Gdk" "Atom"
    IO ()


textBufferUnregisterDeserializeFormat ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Gdk.Atom ->                             -- format
    m ()
textBufferUnregisterDeserializeFormat _obj format = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let format' = unsafeManagedPtrGetPtr format
    gtk_text_buffer_unregister_deserialize_format _obj' format'
    touchManagedPtr _obj
    touchManagedPtr format
    return ()

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

foreign import ccall "gtk_text_buffer_unregister_serialize_format" gtk_text_buffer_unregister_serialize_format :: 
    Ptr TextBuffer ->                       -- _obj : TInterface "Gtk" "TextBuffer"
    Ptr Gdk.Atom ->                         -- format : TInterface "Gdk" "Atom"
    IO ()


textBufferUnregisterSerializeFormat ::
    (MonadIO m, TextBufferK a) =>
    a ->                                    -- _obj
    Gdk.Atom ->                             -- format
    m ()
textBufferUnregisterSerializeFormat _obj format = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let format' = unsafeManagedPtrGetPtr format
    gtk_text_buffer_unregister_serialize_format _obj' format'
    touchManagedPtr _obj
    touchManagedPtr format
    return ()