{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- You may wish to begin by reading the
-- [text widget conceptual overview][TextWidget]
-- which gives an overview of all the objects and data
-- types related to the text widget and how they work together.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gtk.Objects.TextBuffer
    ( 

-- * Exported types
    TextBuffer(..)                          ,
    IsTextBuffer                            ,
    toTextBuffer                            ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveTextBufferMethod                 ,
#endif


-- ** addMark #method:addMark#

#if defined(ENABLE_OVERLOADING)
    TextBufferAddMarkMethodInfo             ,
#endif
    textBufferAddMark                       ,


-- ** addSelectionClipboard #method:addSelectionClipboard#

#if defined(ENABLE_OVERLOADING)
    TextBufferAddSelectionClipboardMethodInfo,
#endif
    textBufferAddSelectionClipboard         ,


-- ** applyTag #method:applyTag#

#if defined(ENABLE_OVERLOADING)
    TextBufferApplyTagMethodInfo            ,
#endif
    textBufferApplyTag                      ,


-- ** applyTagByName #method:applyTagByName#

#if defined(ENABLE_OVERLOADING)
    TextBufferApplyTagByNameMethodInfo      ,
#endif
    textBufferApplyTagByName                ,


-- ** backspace #method:backspace#

#if defined(ENABLE_OVERLOADING)
    TextBufferBackspaceMethodInfo           ,
#endif
    textBufferBackspace                     ,


-- ** beginUserAction #method:beginUserAction#

#if defined(ENABLE_OVERLOADING)
    TextBufferBeginUserActionMethodInfo     ,
#endif
    textBufferBeginUserAction               ,


-- ** copyClipboard #method:copyClipboard#

#if defined(ENABLE_OVERLOADING)
    TextBufferCopyClipboardMethodInfo       ,
#endif
    textBufferCopyClipboard                 ,


-- ** createChildAnchor #method:createChildAnchor#

#if defined(ENABLE_OVERLOADING)
    TextBufferCreateChildAnchorMethodInfo   ,
#endif
    textBufferCreateChildAnchor             ,


-- ** createMark #method:createMark#

#if defined(ENABLE_OVERLOADING)
    TextBufferCreateMarkMethodInfo          ,
#endif
    textBufferCreateMark                    ,


-- ** cutClipboard #method:cutClipboard#

#if defined(ENABLE_OVERLOADING)
    TextBufferCutClipboardMethodInfo        ,
#endif
    textBufferCutClipboard                  ,


-- ** delete #method:delete#

#if defined(ENABLE_OVERLOADING)
    TextBufferDeleteMethodInfo              ,
#endif
    textBufferDelete                        ,


-- ** deleteInteractive #method:deleteInteractive#

#if defined(ENABLE_OVERLOADING)
    TextBufferDeleteInteractiveMethodInfo   ,
#endif
    textBufferDeleteInteractive             ,


-- ** deleteMark #method:deleteMark#

#if defined(ENABLE_OVERLOADING)
    TextBufferDeleteMarkMethodInfo          ,
#endif
    textBufferDeleteMark                    ,


-- ** deleteMarkByName #method:deleteMarkByName#

#if defined(ENABLE_OVERLOADING)
    TextBufferDeleteMarkByNameMethodInfo    ,
#endif
    textBufferDeleteMarkByName              ,


-- ** deleteSelection #method:deleteSelection#

#if defined(ENABLE_OVERLOADING)
    TextBufferDeleteSelectionMethodInfo     ,
#endif
    textBufferDeleteSelection               ,


-- ** deserialize #method:deserialize#

#if defined(ENABLE_OVERLOADING)
    TextBufferDeserializeMethodInfo         ,
#endif
    textBufferDeserialize                   ,


-- ** deserializeGetCanCreateTags #method:deserializeGetCanCreateTags#

#if defined(ENABLE_OVERLOADING)
    TextBufferDeserializeGetCanCreateTagsMethodInfo,
#endif
    textBufferDeserializeGetCanCreateTags   ,


-- ** deserializeSetCanCreateTags #method:deserializeSetCanCreateTags#

#if defined(ENABLE_OVERLOADING)
    TextBufferDeserializeSetCanCreateTagsMethodInfo,
#endif
    textBufferDeserializeSetCanCreateTags   ,


-- ** endUserAction #method:endUserAction#

#if defined(ENABLE_OVERLOADING)
    TextBufferEndUserActionMethodInfo       ,
#endif
    textBufferEndUserAction                 ,


-- ** getBounds #method:getBounds#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetBoundsMethodInfo           ,
#endif
    textBufferGetBounds                     ,


-- ** getCharCount #method:getCharCount#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetCharCountMethodInfo        ,
#endif
    textBufferGetCharCount                  ,


-- ** getCopyTargetList #method:getCopyTargetList#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetCopyTargetListMethodInfo   ,
#endif
    textBufferGetCopyTargetList             ,


-- ** getDeserializeFormats #method:getDeserializeFormats#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetDeserializeFormatsMethodInfo,
#endif
    textBufferGetDeserializeFormats         ,


-- ** getEndIter #method:getEndIter#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetEndIterMethodInfo          ,
#endif
    textBufferGetEndIter                    ,


-- ** getHasSelection #method:getHasSelection#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetHasSelectionMethodInfo     ,
#endif
    textBufferGetHasSelection               ,


-- ** getInsert #method:getInsert#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetInsertMethodInfo           ,
#endif
    textBufferGetInsert                     ,


-- ** getIterAtChildAnchor #method:getIterAtChildAnchor#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetIterAtChildAnchorMethodInfo,
#endif
    textBufferGetIterAtChildAnchor          ,


-- ** getIterAtLine #method:getIterAtLine#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetIterAtLineMethodInfo       ,
#endif
    textBufferGetIterAtLine                 ,


-- ** getIterAtLineIndex #method:getIterAtLineIndex#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetIterAtLineIndexMethodInfo  ,
#endif
    textBufferGetIterAtLineIndex            ,


-- ** getIterAtLineOffset #method:getIterAtLineOffset#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetIterAtLineOffsetMethodInfo ,
#endif
    textBufferGetIterAtLineOffset           ,


-- ** getIterAtMark #method:getIterAtMark#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetIterAtMarkMethodInfo       ,
#endif
    textBufferGetIterAtMark                 ,


-- ** getIterAtOffset #method:getIterAtOffset#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetIterAtOffsetMethodInfo     ,
#endif
    textBufferGetIterAtOffset               ,


-- ** getLineCount #method:getLineCount#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetLineCountMethodInfo        ,
#endif
    textBufferGetLineCount                  ,


-- ** getMark #method:getMark#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetMarkMethodInfo             ,
#endif
    textBufferGetMark                       ,


-- ** getModified #method:getModified#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetModifiedMethodInfo         ,
#endif
    textBufferGetModified                   ,


-- ** getPasteTargetList #method:getPasteTargetList#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetPasteTargetListMethodInfo  ,
#endif
    textBufferGetPasteTargetList            ,


-- ** getSelectionBound #method:getSelectionBound#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetSelectionBoundMethodInfo   ,
#endif
    textBufferGetSelectionBound             ,


-- ** getSelectionBounds #method:getSelectionBounds#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetSelectionBoundsMethodInfo  ,
#endif
    textBufferGetSelectionBounds            ,


-- ** getSerializeFormats #method:getSerializeFormats#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetSerializeFormatsMethodInfo ,
#endif
    textBufferGetSerializeFormats           ,


-- ** getSlice #method:getSlice#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetSliceMethodInfo            ,
#endif
    textBufferGetSlice                      ,


-- ** getStartIter #method:getStartIter#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetStartIterMethodInfo        ,
#endif
    textBufferGetStartIter                  ,


-- ** getTagTable #method:getTagTable#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetTagTableMethodInfo         ,
#endif
    textBufferGetTagTable                   ,


-- ** getText #method:getText#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetTextMethodInfo             ,
#endif
    textBufferGetText                       ,


-- ** insert #method:insert#

#if defined(ENABLE_OVERLOADING)
    TextBufferInsertMethodInfo              ,
#endif
    textBufferInsert                        ,


-- ** insertAtCursor #method:insertAtCursor#

#if defined(ENABLE_OVERLOADING)
    TextBufferInsertAtCursorMethodInfo      ,
#endif
    textBufferInsertAtCursor                ,


-- ** insertChildAnchor #method:insertChildAnchor#

#if defined(ENABLE_OVERLOADING)
    TextBufferInsertChildAnchorMethodInfo   ,
#endif
    textBufferInsertChildAnchor             ,


-- ** insertInteractive #method:insertInteractive#

#if defined(ENABLE_OVERLOADING)
    TextBufferInsertInteractiveMethodInfo   ,
#endif
    textBufferInsertInteractive             ,


-- ** insertInteractiveAtCursor #method:insertInteractiveAtCursor#

#if defined(ENABLE_OVERLOADING)
    TextBufferInsertInteractiveAtCursorMethodInfo,
#endif
    textBufferInsertInteractiveAtCursor     ,


-- ** insertMarkup #method:insertMarkup#

#if defined(ENABLE_OVERLOADING)
    TextBufferInsertMarkupMethodInfo        ,
#endif
    textBufferInsertMarkup                  ,


-- ** insertPixbuf #method:insertPixbuf#

#if defined(ENABLE_OVERLOADING)
    TextBufferInsertPixbufMethodInfo        ,
#endif
    textBufferInsertPixbuf                  ,


-- ** insertRange #method:insertRange#

#if defined(ENABLE_OVERLOADING)
    TextBufferInsertRangeMethodInfo         ,
#endif
    textBufferInsertRange                   ,


-- ** insertRangeInteractive #method:insertRangeInteractive#

#if defined(ENABLE_OVERLOADING)
    TextBufferInsertRangeInteractiveMethodInfo,
#endif
    textBufferInsertRangeInteractive        ,


-- ** moveMark #method:moveMark#

#if defined(ENABLE_OVERLOADING)
    TextBufferMoveMarkMethodInfo            ,
#endif
    textBufferMoveMark                      ,


-- ** moveMarkByName #method:moveMarkByName#

#if defined(ENABLE_OVERLOADING)
    TextBufferMoveMarkByNameMethodInfo      ,
#endif
    textBufferMoveMarkByName                ,


-- ** new #method:new#

    textBufferNew                           ,


-- ** pasteClipboard #method:pasteClipboard#

#if defined(ENABLE_OVERLOADING)
    TextBufferPasteClipboardMethodInfo      ,
#endif
    textBufferPasteClipboard                ,


-- ** placeCursor #method:placeCursor#

#if defined(ENABLE_OVERLOADING)
    TextBufferPlaceCursorMethodInfo         ,
#endif
    textBufferPlaceCursor                   ,


-- ** registerDeserializeFormat #method:registerDeserializeFormat#

#if defined(ENABLE_OVERLOADING)
    TextBufferRegisterDeserializeFormatMethodInfo,
#endif
    textBufferRegisterDeserializeFormat     ,


-- ** registerDeserializeTagset #method:registerDeserializeTagset#

#if defined(ENABLE_OVERLOADING)
    TextBufferRegisterDeserializeTagsetMethodInfo,
#endif
    textBufferRegisterDeserializeTagset     ,


-- ** registerSerializeFormat #method:registerSerializeFormat#

#if defined(ENABLE_OVERLOADING)
    TextBufferRegisterSerializeFormatMethodInfo,
#endif
    textBufferRegisterSerializeFormat       ,


-- ** registerSerializeTagset #method:registerSerializeTagset#

#if defined(ENABLE_OVERLOADING)
    TextBufferRegisterSerializeTagsetMethodInfo,
#endif
    textBufferRegisterSerializeTagset       ,


-- ** removeAllTags #method:removeAllTags#

#if defined(ENABLE_OVERLOADING)
    TextBufferRemoveAllTagsMethodInfo       ,
#endif
    textBufferRemoveAllTags                 ,


-- ** removeSelectionClipboard #method:removeSelectionClipboard#

#if defined(ENABLE_OVERLOADING)
    TextBufferRemoveSelectionClipboardMethodInfo,
#endif
    textBufferRemoveSelectionClipboard      ,


-- ** removeTag #method:removeTag#

#if defined(ENABLE_OVERLOADING)
    TextBufferRemoveTagMethodInfo           ,
#endif
    textBufferRemoveTag                     ,


-- ** removeTagByName #method:removeTagByName#

#if defined(ENABLE_OVERLOADING)
    TextBufferRemoveTagByNameMethodInfo     ,
#endif
    textBufferRemoveTagByName               ,


-- ** selectRange #method:selectRange#

#if defined(ENABLE_OVERLOADING)
    TextBufferSelectRangeMethodInfo         ,
#endif
    textBufferSelectRange                   ,


-- ** serialize #method:serialize#

#if defined(ENABLE_OVERLOADING)
    TextBufferSerializeMethodInfo           ,
#endif
    textBufferSerialize                     ,


-- ** setModified #method:setModified#

#if defined(ENABLE_OVERLOADING)
    TextBufferSetModifiedMethodInfo         ,
#endif
    textBufferSetModified                   ,


-- ** setText #method:setText#

#if defined(ENABLE_OVERLOADING)
    TextBufferSetTextMethodInfo             ,
#endif
    textBufferSetText                       ,


-- ** unregisterDeserializeFormat #method:unregisterDeserializeFormat#

#if defined(ENABLE_OVERLOADING)
    TextBufferUnregisterDeserializeFormatMethodInfo,
#endif
    textBufferUnregisterDeserializeFormat   ,


-- ** unregisterSerializeFormat #method:unregisterSerializeFormat#

#if defined(ENABLE_OVERLOADING)
    TextBufferUnregisterSerializeFormatMethodInfo,
#endif
    textBufferUnregisterSerializeFormat     ,




 -- * Properties
-- ** copyTargetList #attr:copyTargetList#
-- | The list of targets this buffer supports for clipboard copying
-- and as DND source.
-- 
-- /Since: 2.10/

#if defined(ENABLE_OVERLOADING)
    TextBufferCopyTargetListPropertyInfo    ,
#endif
    getTextBufferCopyTargetList             ,
#if defined(ENABLE_OVERLOADING)
    textBufferCopyTargetList                ,
#endif


-- ** cursorPosition #attr:cursorPosition#
-- | The position of the insert mark (as offset from the beginning
-- of the buffer). It is useful for getting notified when the
-- cursor moves.
-- 
-- /Since: 2.10/

#if defined(ENABLE_OVERLOADING)
    TextBufferCursorPositionPropertyInfo    ,
#endif
    getTextBufferCursorPosition             ,
#if defined(ENABLE_OVERLOADING)
    textBufferCursorPosition                ,
#endif


-- ** hasSelection #attr:hasSelection#
-- | Whether the buffer has some text currently selected.
-- 
-- /Since: 2.10/

#if defined(ENABLE_OVERLOADING)
    TextBufferHasSelectionPropertyInfo      ,
#endif
    getTextBufferHasSelection               ,
#if defined(ENABLE_OVERLOADING)
    textBufferHasSelection                  ,
#endif


-- ** pasteTargetList #attr:pasteTargetList#
-- | The list of targets this buffer supports for clipboard pasting
-- and as DND destination.
-- 
-- /Since: 2.10/

#if defined(ENABLE_OVERLOADING)
    TextBufferPasteTargetListPropertyInfo   ,
#endif
    getTextBufferPasteTargetList            ,
#if defined(ENABLE_OVERLOADING)
    textBufferPasteTargetList               ,
#endif


-- ** tagTable #attr:tagTable#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    TextBufferTagTablePropertyInfo          ,
#endif
    constructTextBufferTagTable             ,
    getTextBufferTagTable                   ,
#if defined(ENABLE_OVERLOADING)
    textBufferTagTable                      ,
#endif


-- ** text #attr:text#
-- | The text content of the buffer. Without child widgets and images,
-- see 'GI.Gtk.Objects.TextBuffer.textBufferGetText' for more information.
-- 
-- /Since: 2.8/

#if defined(ENABLE_OVERLOADING)
    TextBufferTextPropertyInfo              ,
#endif
    clearTextBufferText                     ,
    constructTextBufferText                 ,
    getTextBufferText                       ,
    setTextBufferText                       ,
#if defined(ENABLE_OVERLOADING)
    textBufferText                          ,
#endif




 -- * Signals
-- ** applyTag #signal:applyTag#

    C_TextBufferApplyTagCallback            ,
    TextBufferApplyTagCallback              ,
#if defined(ENABLE_OVERLOADING)
    TextBufferApplyTagSignalInfo            ,
#endif
    afterTextBufferApplyTag                 ,
    genClosure_TextBufferApplyTag           ,
    mk_TextBufferApplyTagCallback           ,
    noTextBufferApplyTagCallback            ,
    onTextBufferApplyTag                    ,
    wrap_TextBufferApplyTagCallback         ,


-- ** beginUserAction #signal:beginUserAction#

    C_TextBufferBeginUserActionCallback     ,
    TextBufferBeginUserActionCallback       ,
#if defined(ENABLE_OVERLOADING)
    TextBufferBeginUserActionSignalInfo     ,
#endif
    afterTextBufferBeginUserAction          ,
    genClosure_TextBufferBeginUserAction    ,
    mk_TextBufferBeginUserActionCallback    ,
    noTextBufferBeginUserActionCallback     ,
    onTextBufferBeginUserAction             ,
    wrap_TextBufferBeginUserActionCallback  ,


-- ** changed #signal:changed#

    C_TextBufferChangedCallback             ,
    TextBufferChangedCallback               ,
#if defined(ENABLE_OVERLOADING)
    TextBufferChangedSignalInfo             ,
#endif
    afterTextBufferChanged                  ,
    genClosure_TextBufferChanged            ,
    mk_TextBufferChangedCallback            ,
    noTextBufferChangedCallback             ,
    onTextBufferChanged                     ,
    wrap_TextBufferChangedCallback          ,


-- ** deleteRange #signal:deleteRange#

    C_TextBufferDeleteRangeCallback         ,
    TextBufferDeleteRangeCallback           ,
#if defined(ENABLE_OVERLOADING)
    TextBufferDeleteRangeSignalInfo         ,
#endif
    afterTextBufferDeleteRange              ,
    genClosure_TextBufferDeleteRange        ,
    mk_TextBufferDeleteRangeCallback        ,
    noTextBufferDeleteRangeCallback         ,
    onTextBufferDeleteRange                 ,
    wrap_TextBufferDeleteRangeCallback      ,


-- ** endUserAction #signal:endUserAction#

    C_TextBufferEndUserActionCallback       ,
    TextBufferEndUserActionCallback         ,
#if defined(ENABLE_OVERLOADING)
    TextBufferEndUserActionSignalInfo       ,
#endif
    afterTextBufferEndUserAction            ,
    genClosure_TextBufferEndUserAction      ,
    mk_TextBufferEndUserActionCallback      ,
    noTextBufferEndUserActionCallback       ,
    onTextBufferEndUserAction               ,
    wrap_TextBufferEndUserActionCallback    ,


-- ** insertChildAnchor #signal:insertChildAnchor#

    C_TextBufferInsertChildAnchorCallback   ,
    TextBufferInsertChildAnchorCallback     ,
#if defined(ENABLE_OVERLOADING)
    TextBufferInsertChildAnchorSignalInfo   ,
#endif
    afterTextBufferInsertChildAnchor        ,
    genClosure_TextBufferInsertChildAnchor  ,
    mk_TextBufferInsertChildAnchorCallback  ,
    noTextBufferInsertChildAnchorCallback   ,
    onTextBufferInsertChildAnchor           ,
    wrap_TextBufferInsertChildAnchorCallback,


-- ** insertPixbuf #signal:insertPixbuf#

    C_TextBufferInsertPixbufCallback        ,
    TextBufferInsertPixbufCallback          ,
#if defined(ENABLE_OVERLOADING)
    TextBufferInsertPixbufSignalInfo        ,
#endif
    afterTextBufferInsertPixbuf             ,
    genClosure_TextBufferInsertPixbuf       ,
    mk_TextBufferInsertPixbufCallback       ,
    noTextBufferInsertPixbufCallback        ,
    onTextBufferInsertPixbuf                ,
    wrap_TextBufferInsertPixbufCallback     ,


-- ** insertText #signal:insertText#

    C_TextBufferInsertTextCallback          ,
    TextBufferInsertTextCallback            ,
#if defined(ENABLE_OVERLOADING)
    TextBufferInsertTextSignalInfo          ,
#endif
    afterTextBufferInsertText               ,
    genClosure_TextBufferInsertText         ,
    mk_TextBufferInsertTextCallback         ,
    noTextBufferInsertTextCallback          ,
    onTextBufferInsertText                  ,
    wrap_TextBufferInsertTextCallback       ,


-- ** markDeleted #signal:markDeleted#

    C_TextBufferMarkDeletedCallback         ,
    TextBufferMarkDeletedCallback           ,
#if defined(ENABLE_OVERLOADING)
    TextBufferMarkDeletedSignalInfo         ,
#endif
    afterTextBufferMarkDeleted              ,
    genClosure_TextBufferMarkDeleted        ,
    mk_TextBufferMarkDeletedCallback        ,
    noTextBufferMarkDeletedCallback         ,
    onTextBufferMarkDeleted                 ,
    wrap_TextBufferMarkDeletedCallback      ,


-- ** markSet #signal:markSet#

    C_TextBufferMarkSetCallback             ,
    TextBufferMarkSetCallback               ,
#if defined(ENABLE_OVERLOADING)
    TextBufferMarkSetSignalInfo             ,
#endif
    afterTextBufferMarkSet                  ,
    genClosure_TextBufferMarkSet            ,
    mk_TextBufferMarkSetCallback            ,
    noTextBufferMarkSetCallback             ,
    onTextBufferMarkSet                     ,
    wrap_TextBufferMarkSetCallback          ,


-- ** modifiedChanged #signal:modifiedChanged#

    C_TextBufferModifiedChangedCallback     ,
    TextBufferModifiedChangedCallback       ,
#if defined(ENABLE_OVERLOADING)
    TextBufferModifiedChangedSignalInfo     ,
#endif
    afterTextBufferModifiedChanged          ,
    genClosure_TextBufferModifiedChanged    ,
    mk_TextBufferModifiedChangedCallback    ,
    noTextBufferModifiedChangedCallback     ,
    onTextBufferModifiedChanged             ,
    wrap_TextBufferModifiedChangedCallback  ,


-- ** pasteDone #signal:pasteDone#

    C_TextBufferPasteDoneCallback           ,
    TextBufferPasteDoneCallback             ,
#if defined(ENABLE_OVERLOADING)
    TextBufferPasteDoneSignalInfo           ,
#endif
    afterTextBufferPasteDone                ,
    genClosure_TextBufferPasteDone          ,
    mk_TextBufferPasteDoneCallback          ,
    noTextBufferPasteDoneCallback           ,
    onTextBufferPasteDone                   ,
    wrap_TextBufferPasteDoneCallback        ,


-- ** removeTag #signal:removeTag#

    C_TextBufferRemoveTagCallback           ,
    TextBufferRemoveTagCallback             ,
#if defined(ENABLE_OVERLOADING)
    TextBufferRemoveTagSignalInfo           ,
#endif
    afterTextBufferRemoveTag                ,
    genClosure_TextBufferRemoveTag          ,
    mk_TextBufferRemoveTagCallback          ,
    noTextBufferRemoveTagCallback           ,
    onTextBufferRemoveTag                   ,
    wrap_TextBufferRemoveTagCallback        ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Structs.Atom as Gdk.Atom
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Objects.Clipboard as Gtk.Clipboard
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextChildAnchor as Gtk.TextChildAnchor
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextMark as Gtk.TextMark
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextTag as Gtk.TextTag
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextTagTable as Gtk.TextTagTable
import {-# SOURCE #-} qualified GI.Gtk.Structs.TargetList as Gtk.TargetList
import {-# SOURCE #-} qualified GI.Gtk.Structs.TextIter as Gtk.TextIter

-- | Memory-managed wrapper type.
newtype TextBuffer = TextBuffer (SP.ManagedPtr TextBuffer)
    deriving (TextBuffer -> TextBuffer -> Bool
(TextBuffer -> TextBuffer -> Bool)
-> (TextBuffer -> TextBuffer -> Bool) -> Eq TextBuffer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextBuffer -> TextBuffer -> Bool
$c/= :: TextBuffer -> TextBuffer -> Bool
== :: TextBuffer -> TextBuffer -> Bool
$c== :: TextBuffer -> TextBuffer -> Bool
Eq)

instance SP.ManagedPtrNewtype TextBuffer where
    toManagedPtr :: TextBuffer -> ManagedPtr TextBuffer
toManagedPtr (TextBuffer ManagedPtr TextBuffer
p) = ManagedPtr TextBuffer
p

foreign import ccall "gtk_text_buffer_get_type"
    c_gtk_text_buffer_get_type :: IO B.Types.GType

instance B.Types.TypedObject TextBuffer where
    glibType :: IO GType
glibType = IO GType
c_gtk_text_buffer_get_type

instance B.Types.GObject TextBuffer

-- | Convert 'TextBuffer' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue TextBuffer where
    toGValue :: TextBuffer -> IO GValue
toGValue TextBuffer
o = do
        GType
gtype <- IO GType
c_gtk_text_buffer_get_type
        TextBuffer -> (Ptr TextBuffer -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TextBuffer
o (GType
-> (GValue -> Ptr TextBuffer -> IO ())
-> Ptr TextBuffer
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr TextBuffer -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO TextBuffer
fromGValue GValue
gv = do
        Ptr TextBuffer
ptr <- GValue -> IO (Ptr TextBuffer)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr TextBuffer)
        (ManagedPtr TextBuffer -> TextBuffer)
-> Ptr TextBuffer -> IO TextBuffer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr TextBuffer -> TextBuffer
TextBuffer Ptr TextBuffer
ptr
        
    

-- | Type class for types which can be safely cast to `TextBuffer`, for instance with `toTextBuffer`.
class (SP.GObject o, O.IsDescendantOf TextBuffer o) => IsTextBuffer o
instance (SP.GObject o, O.IsDescendantOf TextBuffer o) => IsTextBuffer o

instance O.HasParentTypes TextBuffer
type instance O.ParentTypes TextBuffer = '[GObject.Object.Object]

-- | Cast to `TextBuffer`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toTextBuffer :: (MonadIO m, IsTextBuffer o) => o -> m TextBuffer
toTextBuffer :: o -> m TextBuffer
toTextBuffer = IO TextBuffer -> m TextBuffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextBuffer -> m TextBuffer)
-> (o -> IO TextBuffer) -> o -> m TextBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr TextBuffer -> TextBuffer) -> o -> IO TextBuffer
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr TextBuffer -> TextBuffer
TextBuffer

#if defined(ENABLE_OVERLOADING)
type family ResolveTextBufferMethod (t :: Symbol) (o :: *) :: * where
    ResolveTextBufferMethod "addMark" o = TextBufferAddMarkMethodInfo
    ResolveTextBufferMethod "addSelectionClipboard" o = TextBufferAddSelectionClipboardMethodInfo
    ResolveTextBufferMethod "applyTag" o = TextBufferApplyTagMethodInfo
    ResolveTextBufferMethod "applyTagByName" o = TextBufferApplyTagByNameMethodInfo
    ResolveTextBufferMethod "backspace" o = TextBufferBackspaceMethodInfo
    ResolveTextBufferMethod "beginUserAction" o = TextBufferBeginUserActionMethodInfo
    ResolveTextBufferMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTextBufferMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTextBufferMethod "copyClipboard" o = TextBufferCopyClipboardMethodInfo
    ResolveTextBufferMethod "createChildAnchor" o = TextBufferCreateChildAnchorMethodInfo
    ResolveTextBufferMethod "createMark" o = TextBufferCreateMarkMethodInfo
    ResolveTextBufferMethod "cutClipboard" o = TextBufferCutClipboardMethodInfo
    ResolveTextBufferMethod "delete" o = TextBufferDeleteMethodInfo
    ResolveTextBufferMethod "deleteInteractive" o = TextBufferDeleteInteractiveMethodInfo
    ResolveTextBufferMethod "deleteMark" o = TextBufferDeleteMarkMethodInfo
    ResolveTextBufferMethod "deleteMarkByName" o = TextBufferDeleteMarkByNameMethodInfo
    ResolveTextBufferMethod "deleteSelection" o = TextBufferDeleteSelectionMethodInfo
    ResolveTextBufferMethod "deserialize" o = TextBufferDeserializeMethodInfo
    ResolveTextBufferMethod "deserializeGetCanCreateTags" o = TextBufferDeserializeGetCanCreateTagsMethodInfo
    ResolveTextBufferMethod "deserializeSetCanCreateTags" o = TextBufferDeserializeSetCanCreateTagsMethodInfo
    ResolveTextBufferMethod "endUserAction" o = TextBufferEndUserActionMethodInfo
    ResolveTextBufferMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTextBufferMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTextBufferMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTextBufferMethod "insert" o = TextBufferInsertMethodInfo
    ResolveTextBufferMethod "insertAtCursor" o = TextBufferInsertAtCursorMethodInfo
    ResolveTextBufferMethod "insertChildAnchor" o = TextBufferInsertChildAnchorMethodInfo
    ResolveTextBufferMethod "insertInteractive" o = TextBufferInsertInteractiveMethodInfo
    ResolveTextBufferMethod "insertInteractiveAtCursor" o = TextBufferInsertInteractiveAtCursorMethodInfo
    ResolveTextBufferMethod "insertMarkup" o = TextBufferInsertMarkupMethodInfo
    ResolveTextBufferMethod "insertPixbuf" o = TextBufferInsertPixbufMethodInfo
    ResolveTextBufferMethod "insertRange" o = TextBufferInsertRangeMethodInfo
    ResolveTextBufferMethod "insertRangeInteractive" o = TextBufferInsertRangeInteractiveMethodInfo
    ResolveTextBufferMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTextBufferMethod "moveMark" o = TextBufferMoveMarkMethodInfo
    ResolveTextBufferMethod "moveMarkByName" o = TextBufferMoveMarkByNameMethodInfo
    ResolveTextBufferMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTextBufferMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTextBufferMethod "pasteClipboard" o = TextBufferPasteClipboardMethodInfo
    ResolveTextBufferMethod "placeCursor" o = TextBufferPlaceCursorMethodInfo
    ResolveTextBufferMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTextBufferMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTextBufferMethod "registerDeserializeFormat" o = TextBufferRegisterDeserializeFormatMethodInfo
    ResolveTextBufferMethod "registerDeserializeTagset" o = TextBufferRegisterDeserializeTagsetMethodInfo
    ResolveTextBufferMethod "registerSerializeFormat" o = TextBufferRegisterSerializeFormatMethodInfo
    ResolveTextBufferMethod "registerSerializeTagset" o = TextBufferRegisterSerializeTagsetMethodInfo
    ResolveTextBufferMethod "removeAllTags" o = TextBufferRemoveAllTagsMethodInfo
    ResolveTextBufferMethod "removeSelectionClipboard" o = TextBufferRemoveSelectionClipboardMethodInfo
    ResolveTextBufferMethod "removeTag" o = TextBufferRemoveTagMethodInfo
    ResolveTextBufferMethod "removeTagByName" o = TextBufferRemoveTagByNameMethodInfo
    ResolveTextBufferMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTextBufferMethod "selectRange" o = TextBufferSelectRangeMethodInfo
    ResolveTextBufferMethod "serialize" o = TextBufferSerializeMethodInfo
    ResolveTextBufferMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTextBufferMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTextBufferMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTextBufferMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTextBufferMethod "unregisterDeserializeFormat" o = TextBufferUnregisterDeserializeFormatMethodInfo
    ResolveTextBufferMethod "unregisterSerializeFormat" o = TextBufferUnregisterSerializeFormatMethodInfo
    ResolveTextBufferMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTextBufferMethod "getBounds" o = TextBufferGetBoundsMethodInfo
    ResolveTextBufferMethod "getCharCount" o = TextBufferGetCharCountMethodInfo
    ResolveTextBufferMethod "getCopyTargetList" o = TextBufferGetCopyTargetListMethodInfo
    ResolveTextBufferMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTextBufferMethod "getDeserializeFormats" o = TextBufferGetDeserializeFormatsMethodInfo
    ResolveTextBufferMethod "getEndIter" o = TextBufferGetEndIterMethodInfo
    ResolveTextBufferMethod "getHasSelection" o = TextBufferGetHasSelectionMethodInfo
    ResolveTextBufferMethod "getInsert" o = TextBufferGetInsertMethodInfo
    ResolveTextBufferMethod "getIterAtChildAnchor" o = TextBufferGetIterAtChildAnchorMethodInfo
    ResolveTextBufferMethod "getIterAtLine" o = TextBufferGetIterAtLineMethodInfo
    ResolveTextBufferMethod "getIterAtLineIndex" o = TextBufferGetIterAtLineIndexMethodInfo
    ResolveTextBufferMethod "getIterAtLineOffset" o = TextBufferGetIterAtLineOffsetMethodInfo
    ResolveTextBufferMethod "getIterAtMark" o = TextBufferGetIterAtMarkMethodInfo
    ResolveTextBufferMethod "getIterAtOffset" o = TextBufferGetIterAtOffsetMethodInfo
    ResolveTextBufferMethod "getLineCount" o = TextBufferGetLineCountMethodInfo
    ResolveTextBufferMethod "getMark" o = TextBufferGetMarkMethodInfo
    ResolveTextBufferMethod "getModified" o = TextBufferGetModifiedMethodInfo
    ResolveTextBufferMethod "getPasteTargetList" o = TextBufferGetPasteTargetListMethodInfo
    ResolveTextBufferMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTextBufferMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTextBufferMethod "getSelectionBound" o = TextBufferGetSelectionBoundMethodInfo
    ResolveTextBufferMethod "getSelectionBounds" o = TextBufferGetSelectionBoundsMethodInfo
    ResolveTextBufferMethod "getSerializeFormats" o = TextBufferGetSerializeFormatsMethodInfo
    ResolveTextBufferMethod "getSlice" o = TextBufferGetSliceMethodInfo
    ResolveTextBufferMethod "getStartIter" o = TextBufferGetStartIterMethodInfo
    ResolveTextBufferMethod "getTagTable" o = TextBufferGetTagTableMethodInfo
    ResolveTextBufferMethod "getText" o = TextBufferGetTextMethodInfo
    ResolveTextBufferMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTextBufferMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTextBufferMethod "setModified" o = TextBufferSetModifiedMethodInfo
    ResolveTextBufferMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTextBufferMethod "setText" o = TextBufferSetTextMethodInfo
    ResolveTextBufferMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveTextBufferMethod t TextBuffer, O.MethodInfo info TextBuffer p) => OL.IsLabel t (TextBuffer -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- signal TextBuffer::apply-tag
-- | The [applyTag](#g:signal:applyTag) signal is emitted to apply a tag to a
-- range of text in a t'GI.Gtk.Objects.TextBuffer.TextBuffer'.
-- Applying actually occurs in the default handler.
-- 
-- Note that if your handler runs before the default handler it must not
-- invalidate the /@start@/ and /@end@/ iters (or has to revalidate them).
-- 
-- See also:
-- 'GI.Gtk.Objects.TextBuffer.textBufferApplyTag',
-- @/gtk_text_buffer_insert_with_tags()/@,
-- 'GI.Gtk.Objects.TextBuffer.textBufferInsertRange'.
type TextBufferApplyTagCallback =
    Gtk.TextTag.TextTag
    -- ^ /@tag@/: the applied tag
    -> Gtk.TextIter.TextIter
    -- ^ /@start@/: the start of the range the tag is applied to
    -> Gtk.TextIter.TextIter
    -- ^ /@end@/: the end of the range the tag is applied to
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferApplyTagCallback`@.
noTextBufferApplyTagCallback :: Maybe TextBufferApplyTagCallback
noTextBufferApplyTagCallback :: Maybe TextBufferApplyTagCallback
noTextBufferApplyTagCallback = Maybe TextBufferApplyTagCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferApplyTagCallback =
    Ptr () ->                               -- object
    Ptr Gtk.TextTag.TextTag ->
    Ptr Gtk.TextIter.TextIter ->
    Ptr Gtk.TextIter.TextIter ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferApplyTagCallback`.
foreign import ccall "wrapper"
    mk_TextBufferApplyTagCallback :: C_TextBufferApplyTagCallback -> IO (FunPtr C_TextBufferApplyTagCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferApplyTag :: MonadIO m => TextBufferApplyTagCallback -> m (GClosure C_TextBufferApplyTagCallback)
genClosure_TextBufferApplyTag :: TextBufferApplyTagCallback
-> m (GClosure C_TextBufferApplyTagCallback)
genClosure_TextBufferApplyTag TextBufferApplyTagCallback
cb = IO (GClosure C_TextBufferApplyTagCallback)
-> m (GClosure C_TextBufferApplyTagCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferApplyTagCallback)
 -> m (GClosure C_TextBufferApplyTagCallback))
-> IO (GClosure C_TextBufferApplyTagCallback)
-> m (GClosure C_TextBufferApplyTagCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferApplyTagCallback
cb' = TextBufferApplyTagCallback -> C_TextBufferApplyTagCallback
wrap_TextBufferApplyTagCallback TextBufferApplyTagCallback
cb
    C_TextBufferApplyTagCallback
-> IO (FunPtr C_TextBufferApplyTagCallback)
mk_TextBufferApplyTagCallback C_TextBufferApplyTagCallback
cb' IO (FunPtr C_TextBufferApplyTagCallback)
-> (FunPtr C_TextBufferApplyTagCallback
    -> IO (GClosure C_TextBufferApplyTagCallback))
-> IO (GClosure C_TextBufferApplyTagCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferApplyTagCallback
-> IO (GClosure C_TextBufferApplyTagCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferApplyTagCallback` into a `C_TextBufferApplyTagCallback`.
wrap_TextBufferApplyTagCallback ::
    TextBufferApplyTagCallback ->
    C_TextBufferApplyTagCallback
wrap_TextBufferApplyTagCallback :: TextBufferApplyTagCallback -> C_TextBufferApplyTagCallback
wrap_TextBufferApplyTagCallback TextBufferApplyTagCallback
_cb Ptr ()
_ Ptr TextTag
tag Ptr TextIter
start Ptr TextIter
end Ptr ()
_ = do
    TextTag
tag' <- ((ManagedPtr TextTag -> TextTag) -> Ptr TextTag -> IO TextTag
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TextTag -> TextTag
Gtk.TextTag.TextTag) Ptr TextTag
tag
    (ManagedPtr TextIter -> TextIter)
-> Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter Ptr TextIter
start ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
start' -> do
        (ManagedPtr TextIter -> TextIter)
-> Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter Ptr TextIter
end ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
end' -> do
            TextBufferApplyTagCallback
_cb  TextTag
tag' TextIter
start' TextIter
end'


-- | Connect a signal handler for the [applyTag](#signal:applyTag) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #applyTag callback
-- @
-- 
-- 
onTextBufferApplyTag :: (IsTextBuffer a, MonadIO m) => a -> TextBufferApplyTagCallback -> m SignalHandlerId
onTextBufferApplyTag :: a -> TextBufferApplyTagCallback -> m SignalHandlerId
onTextBufferApplyTag a
obj TextBufferApplyTagCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferApplyTagCallback
cb' = TextBufferApplyTagCallback -> C_TextBufferApplyTagCallback
wrap_TextBufferApplyTagCallback TextBufferApplyTagCallback
cb
    FunPtr C_TextBufferApplyTagCallback
cb'' <- C_TextBufferApplyTagCallback
-> IO (FunPtr C_TextBufferApplyTagCallback)
mk_TextBufferApplyTagCallback C_TextBufferApplyTagCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferApplyTagCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"apply-tag" FunPtr C_TextBufferApplyTagCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [applyTag](#signal:applyTag) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #applyTag callback
-- @
-- 
-- 
afterTextBufferApplyTag :: (IsTextBuffer a, MonadIO m) => a -> TextBufferApplyTagCallback -> m SignalHandlerId
afterTextBufferApplyTag :: a -> TextBufferApplyTagCallback -> m SignalHandlerId
afterTextBufferApplyTag a
obj TextBufferApplyTagCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferApplyTagCallback
cb' = TextBufferApplyTagCallback -> C_TextBufferApplyTagCallback
wrap_TextBufferApplyTagCallback TextBufferApplyTagCallback
cb
    FunPtr C_TextBufferApplyTagCallback
cb'' <- C_TextBufferApplyTagCallback
-> IO (FunPtr C_TextBufferApplyTagCallback)
mk_TextBufferApplyTagCallback C_TextBufferApplyTagCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferApplyTagCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"apply-tag" FunPtr C_TextBufferApplyTagCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferApplyTagSignalInfo
instance SignalInfo TextBufferApplyTagSignalInfo where
    type HaskellCallbackType TextBufferApplyTagSignalInfo = TextBufferApplyTagCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferApplyTagCallback cb
        cb'' <- mk_TextBufferApplyTagCallback cb'
        connectSignalFunPtr obj "apply-tag" cb'' connectMode detail

#endif

-- signal TextBuffer::begin-user-action
-- | The [beginUserAction](#g:signal:beginUserAction) signal is emitted at the beginning of a single
-- user-visible operation on a t'GI.Gtk.Objects.TextBuffer.TextBuffer'.
-- 
-- See also:
-- 'GI.Gtk.Objects.TextBuffer.textBufferBeginUserAction',
-- 'GI.Gtk.Objects.TextBuffer.textBufferInsertInteractive',
-- 'GI.Gtk.Objects.TextBuffer.textBufferInsertRangeInteractive',
-- 'GI.Gtk.Objects.TextBuffer.textBufferDeleteInteractive',
-- 'GI.Gtk.Objects.TextBuffer.textBufferBackspace',
-- 'GI.Gtk.Objects.TextBuffer.textBufferDeleteSelection'.
type TextBufferBeginUserActionCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferBeginUserActionCallback`@.
noTextBufferBeginUserActionCallback :: Maybe TextBufferBeginUserActionCallback
noTextBufferBeginUserActionCallback :: Maybe (IO ())
noTextBufferBeginUserActionCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferBeginUserActionCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferBeginUserActionCallback`.
foreign import ccall "wrapper"
    mk_TextBufferBeginUserActionCallback :: C_TextBufferBeginUserActionCallback -> IO (FunPtr C_TextBufferBeginUserActionCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferBeginUserAction :: MonadIO m => TextBufferBeginUserActionCallback -> m (GClosure C_TextBufferBeginUserActionCallback)
genClosure_TextBufferBeginUserAction :: IO () -> m (GClosure C_TextBufferBeginUserActionCallback)
genClosure_TextBufferBeginUserAction IO ()
cb = IO (GClosure C_TextBufferBeginUserActionCallback)
-> m (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferBeginUserActionCallback)
 -> m (GClosure C_TextBufferBeginUserActionCallback))
-> IO (GClosure C_TextBufferBeginUserActionCallback)
-> m (GClosure C_TextBufferBeginUserActionCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferBeginUserActionCallback IO ()
cb
    C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferBeginUserActionCallback C_TextBufferBeginUserActionCallback
cb' IO (FunPtr C_TextBufferBeginUserActionCallback)
-> (FunPtr C_TextBufferBeginUserActionCallback
    -> IO (GClosure C_TextBufferBeginUserActionCallback))
-> IO (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferBeginUserActionCallback
-> IO (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferBeginUserActionCallback` into a `C_TextBufferBeginUserActionCallback`.
wrap_TextBufferBeginUserActionCallback ::
    TextBufferBeginUserActionCallback ->
    C_TextBufferBeginUserActionCallback
wrap_TextBufferBeginUserActionCallback :: IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferBeginUserActionCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [beginUserAction](#signal:beginUserAction) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #beginUserAction callback
-- @
-- 
-- 
onTextBufferBeginUserAction :: (IsTextBuffer a, MonadIO m) => a -> TextBufferBeginUserActionCallback -> m SignalHandlerId
onTextBufferBeginUserAction :: a -> IO () -> m SignalHandlerId
onTextBufferBeginUserAction a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferBeginUserActionCallback IO ()
cb
    FunPtr C_TextBufferBeginUserActionCallback
cb'' <- C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferBeginUserActionCallback C_TextBufferBeginUserActionCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferBeginUserActionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"begin-user-action" FunPtr C_TextBufferBeginUserActionCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [beginUserAction](#signal:beginUserAction) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #beginUserAction callback
-- @
-- 
-- 
afterTextBufferBeginUserAction :: (IsTextBuffer a, MonadIO m) => a -> TextBufferBeginUserActionCallback -> m SignalHandlerId
afterTextBufferBeginUserAction :: a -> IO () -> m SignalHandlerId
afterTextBufferBeginUserAction a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferBeginUserActionCallback IO ()
cb
    FunPtr C_TextBufferBeginUserActionCallback
cb'' <- C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferBeginUserActionCallback C_TextBufferBeginUserActionCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferBeginUserActionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"begin-user-action" FunPtr C_TextBufferBeginUserActionCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferBeginUserActionSignalInfo
instance SignalInfo TextBufferBeginUserActionSignalInfo where
    type HaskellCallbackType TextBufferBeginUserActionSignalInfo = TextBufferBeginUserActionCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferBeginUserActionCallback cb
        cb'' <- mk_TextBufferBeginUserActionCallback cb'
        connectSignalFunPtr obj "begin-user-action" cb'' connectMode detail

#endif

-- signal TextBuffer::changed
-- | The [changed](#g:signal:changed) signal is emitted when the content of a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
-- has changed.
type TextBufferChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferChangedCallback`@.
noTextBufferChangedCallback :: Maybe TextBufferChangedCallback
noTextBufferChangedCallback :: Maybe (IO ())
noTextBufferChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferChangedCallback`.
foreign import ccall "wrapper"
    mk_TextBufferChangedCallback :: C_TextBufferChangedCallback -> IO (FunPtr C_TextBufferChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferChanged :: MonadIO m => TextBufferChangedCallback -> m (GClosure C_TextBufferChangedCallback)
genClosure_TextBufferChanged :: IO () -> m (GClosure C_TextBufferBeginUserActionCallback)
genClosure_TextBufferChanged IO ()
cb = IO (GClosure C_TextBufferBeginUserActionCallback)
-> m (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferBeginUserActionCallback)
 -> m (GClosure C_TextBufferBeginUserActionCallback))
-> IO (GClosure C_TextBufferBeginUserActionCallback)
-> m (GClosure C_TextBufferBeginUserActionCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferChangedCallback IO ()
cb
    C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferChangedCallback C_TextBufferBeginUserActionCallback
cb' IO (FunPtr C_TextBufferBeginUserActionCallback)
-> (FunPtr C_TextBufferBeginUserActionCallback
    -> IO (GClosure C_TextBufferBeginUserActionCallback))
-> IO (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferBeginUserActionCallback
-> IO (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferChangedCallback` into a `C_TextBufferChangedCallback`.
wrap_TextBufferChangedCallback ::
    TextBufferChangedCallback ->
    C_TextBufferChangedCallback
wrap_TextBufferChangedCallback :: IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #changed callback
-- @
-- 
-- 
onTextBufferChanged :: (IsTextBuffer a, MonadIO m) => a -> TextBufferChangedCallback -> m SignalHandlerId
onTextBufferChanged :: a -> IO () -> m SignalHandlerId
onTextBufferChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferChangedCallback IO ()
cb
    FunPtr C_TextBufferBeginUserActionCallback
cb'' <- C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferChangedCallback C_TextBufferBeginUserActionCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferBeginUserActionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_TextBufferBeginUserActionCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #changed callback
-- @
-- 
-- 
afterTextBufferChanged :: (IsTextBuffer a, MonadIO m) => a -> TextBufferChangedCallback -> m SignalHandlerId
afterTextBufferChanged :: a -> IO () -> m SignalHandlerId
afterTextBufferChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferChangedCallback IO ()
cb
    FunPtr C_TextBufferBeginUserActionCallback
cb'' <- C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferChangedCallback C_TextBufferBeginUserActionCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferBeginUserActionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_TextBufferBeginUserActionCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferChangedSignalInfo
instance SignalInfo TextBufferChangedSignalInfo where
    type HaskellCallbackType TextBufferChangedSignalInfo = TextBufferChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferChangedCallback cb
        cb'' <- mk_TextBufferChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail

#endif

-- signal TextBuffer::delete-range
-- | The [deleteRange](#g:signal:deleteRange) signal is emitted to delete a range
-- from a t'GI.Gtk.Objects.TextBuffer.TextBuffer'.
-- 
-- Note that if your handler runs before the default handler it must not
-- invalidate the /@start@/ and /@end@/ iters (or has to revalidate them).
-- The default signal handler revalidates the /@start@/ and /@end@/ iters to
-- both point to the location where text was deleted. Handlers
-- which run after the default handler (see @/g_signal_connect_after()/@)
-- do not have access to the deleted text.
-- 
-- See also: 'GI.Gtk.Objects.TextBuffer.textBufferDelete'.
type TextBufferDeleteRangeCallback =
    Gtk.TextIter.TextIter
    -- ^ /@start@/: the start of the range to be deleted
    -> Gtk.TextIter.TextIter
    -- ^ /@end@/: the end of the range to be deleted
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferDeleteRangeCallback`@.
noTextBufferDeleteRangeCallback :: Maybe TextBufferDeleteRangeCallback
noTextBufferDeleteRangeCallback :: Maybe TextBufferDeleteRangeCallback
noTextBufferDeleteRangeCallback = Maybe TextBufferDeleteRangeCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferDeleteRangeCallback =
    Ptr () ->                               -- object
    Ptr Gtk.TextIter.TextIter ->
    Ptr Gtk.TextIter.TextIter ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferDeleteRangeCallback`.
foreign import ccall "wrapper"
    mk_TextBufferDeleteRangeCallback :: C_TextBufferDeleteRangeCallback -> IO (FunPtr C_TextBufferDeleteRangeCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferDeleteRange :: MonadIO m => TextBufferDeleteRangeCallback -> m (GClosure C_TextBufferDeleteRangeCallback)
genClosure_TextBufferDeleteRange :: TextBufferDeleteRangeCallback
-> m (GClosure C_TextBufferDeleteRangeCallback)
genClosure_TextBufferDeleteRange TextBufferDeleteRangeCallback
cb = IO (GClosure C_TextBufferDeleteRangeCallback)
-> m (GClosure C_TextBufferDeleteRangeCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferDeleteRangeCallback)
 -> m (GClosure C_TextBufferDeleteRangeCallback))
-> IO (GClosure C_TextBufferDeleteRangeCallback)
-> m (GClosure C_TextBufferDeleteRangeCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferDeleteRangeCallback
cb' = TextBufferDeleteRangeCallback -> C_TextBufferDeleteRangeCallback
wrap_TextBufferDeleteRangeCallback TextBufferDeleteRangeCallback
cb
    C_TextBufferDeleteRangeCallback
-> IO (FunPtr C_TextBufferDeleteRangeCallback)
mk_TextBufferDeleteRangeCallback C_TextBufferDeleteRangeCallback
cb' IO (FunPtr C_TextBufferDeleteRangeCallback)
-> (FunPtr C_TextBufferDeleteRangeCallback
    -> IO (GClosure C_TextBufferDeleteRangeCallback))
-> IO (GClosure C_TextBufferDeleteRangeCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferDeleteRangeCallback
-> IO (GClosure C_TextBufferDeleteRangeCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferDeleteRangeCallback` into a `C_TextBufferDeleteRangeCallback`.
wrap_TextBufferDeleteRangeCallback ::
    TextBufferDeleteRangeCallback ->
    C_TextBufferDeleteRangeCallback
wrap_TextBufferDeleteRangeCallback :: TextBufferDeleteRangeCallback -> C_TextBufferDeleteRangeCallback
wrap_TextBufferDeleteRangeCallback TextBufferDeleteRangeCallback
_cb Ptr ()
_ Ptr TextIter
start Ptr TextIter
end Ptr ()
_ = do
    (ManagedPtr TextIter -> TextIter)
-> Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter Ptr TextIter
start ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
start' -> do
        (ManagedPtr TextIter -> TextIter)
-> Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter Ptr TextIter
end ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
end' -> do
            TextBufferDeleteRangeCallback
_cb  TextIter
start' TextIter
end'


-- | Connect a signal handler for the [deleteRange](#signal:deleteRange) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #deleteRange callback
-- @
-- 
-- 
onTextBufferDeleteRange :: (IsTextBuffer a, MonadIO m) => a -> TextBufferDeleteRangeCallback -> m SignalHandlerId
onTextBufferDeleteRange :: a -> TextBufferDeleteRangeCallback -> m SignalHandlerId
onTextBufferDeleteRange a
obj TextBufferDeleteRangeCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferDeleteRangeCallback
cb' = TextBufferDeleteRangeCallback -> C_TextBufferDeleteRangeCallback
wrap_TextBufferDeleteRangeCallback TextBufferDeleteRangeCallback
cb
    FunPtr C_TextBufferDeleteRangeCallback
cb'' <- C_TextBufferDeleteRangeCallback
-> IO (FunPtr C_TextBufferDeleteRangeCallback)
mk_TextBufferDeleteRangeCallback C_TextBufferDeleteRangeCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferDeleteRangeCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"delete-range" FunPtr C_TextBufferDeleteRangeCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deleteRange](#signal:deleteRange) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #deleteRange callback
-- @
-- 
-- 
afterTextBufferDeleteRange :: (IsTextBuffer a, MonadIO m) => a -> TextBufferDeleteRangeCallback -> m SignalHandlerId
afterTextBufferDeleteRange :: a -> TextBufferDeleteRangeCallback -> m SignalHandlerId
afterTextBufferDeleteRange a
obj TextBufferDeleteRangeCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferDeleteRangeCallback
cb' = TextBufferDeleteRangeCallback -> C_TextBufferDeleteRangeCallback
wrap_TextBufferDeleteRangeCallback TextBufferDeleteRangeCallback
cb
    FunPtr C_TextBufferDeleteRangeCallback
cb'' <- C_TextBufferDeleteRangeCallback
-> IO (FunPtr C_TextBufferDeleteRangeCallback)
mk_TextBufferDeleteRangeCallback C_TextBufferDeleteRangeCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferDeleteRangeCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"delete-range" FunPtr C_TextBufferDeleteRangeCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferDeleteRangeSignalInfo
instance SignalInfo TextBufferDeleteRangeSignalInfo where
    type HaskellCallbackType TextBufferDeleteRangeSignalInfo = TextBufferDeleteRangeCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferDeleteRangeCallback cb
        cb'' <- mk_TextBufferDeleteRangeCallback cb'
        connectSignalFunPtr obj "delete-range" cb'' connectMode detail

#endif

-- signal TextBuffer::end-user-action
-- | The [endUserAction](#g:signal:endUserAction) signal is emitted at the end of a single
-- user-visible operation on the t'GI.Gtk.Objects.TextBuffer.TextBuffer'.
-- 
-- See also:
-- 'GI.Gtk.Objects.TextBuffer.textBufferEndUserAction',
-- 'GI.Gtk.Objects.TextBuffer.textBufferInsertInteractive',
-- 'GI.Gtk.Objects.TextBuffer.textBufferInsertRangeInteractive',
-- 'GI.Gtk.Objects.TextBuffer.textBufferDeleteInteractive',
-- 'GI.Gtk.Objects.TextBuffer.textBufferBackspace',
-- 'GI.Gtk.Objects.TextBuffer.textBufferDeleteSelection',
-- 'GI.Gtk.Objects.TextBuffer.textBufferBackspace'.
type TextBufferEndUserActionCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferEndUserActionCallback`@.
noTextBufferEndUserActionCallback :: Maybe TextBufferEndUserActionCallback
noTextBufferEndUserActionCallback :: Maybe (IO ())
noTextBufferEndUserActionCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferEndUserActionCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferEndUserActionCallback`.
foreign import ccall "wrapper"
    mk_TextBufferEndUserActionCallback :: C_TextBufferEndUserActionCallback -> IO (FunPtr C_TextBufferEndUserActionCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferEndUserAction :: MonadIO m => TextBufferEndUserActionCallback -> m (GClosure C_TextBufferEndUserActionCallback)
genClosure_TextBufferEndUserAction :: IO () -> m (GClosure C_TextBufferBeginUserActionCallback)
genClosure_TextBufferEndUserAction IO ()
cb = IO (GClosure C_TextBufferBeginUserActionCallback)
-> m (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferBeginUserActionCallback)
 -> m (GClosure C_TextBufferBeginUserActionCallback))
-> IO (GClosure C_TextBufferBeginUserActionCallback)
-> m (GClosure C_TextBufferBeginUserActionCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferEndUserActionCallback IO ()
cb
    C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferEndUserActionCallback C_TextBufferBeginUserActionCallback
cb' IO (FunPtr C_TextBufferBeginUserActionCallback)
-> (FunPtr C_TextBufferBeginUserActionCallback
    -> IO (GClosure C_TextBufferBeginUserActionCallback))
-> IO (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferBeginUserActionCallback
-> IO (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferEndUserActionCallback` into a `C_TextBufferEndUserActionCallback`.
wrap_TextBufferEndUserActionCallback ::
    TextBufferEndUserActionCallback ->
    C_TextBufferEndUserActionCallback
wrap_TextBufferEndUserActionCallback :: IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferEndUserActionCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [endUserAction](#signal:endUserAction) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #endUserAction callback
-- @
-- 
-- 
onTextBufferEndUserAction :: (IsTextBuffer a, MonadIO m) => a -> TextBufferEndUserActionCallback -> m SignalHandlerId
onTextBufferEndUserAction :: a -> IO () -> m SignalHandlerId
onTextBufferEndUserAction a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferEndUserActionCallback IO ()
cb
    FunPtr C_TextBufferBeginUserActionCallback
cb'' <- C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferEndUserActionCallback C_TextBufferBeginUserActionCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferBeginUserActionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"end-user-action" FunPtr C_TextBufferBeginUserActionCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [endUserAction](#signal:endUserAction) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #endUserAction callback
-- @
-- 
-- 
afterTextBufferEndUserAction :: (IsTextBuffer a, MonadIO m) => a -> TextBufferEndUserActionCallback -> m SignalHandlerId
afterTextBufferEndUserAction :: a -> IO () -> m SignalHandlerId
afterTextBufferEndUserAction a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferEndUserActionCallback IO ()
cb
    FunPtr C_TextBufferBeginUserActionCallback
cb'' <- C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferEndUserActionCallback C_TextBufferBeginUserActionCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferBeginUserActionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"end-user-action" FunPtr C_TextBufferBeginUserActionCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferEndUserActionSignalInfo
instance SignalInfo TextBufferEndUserActionSignalInfo where
    type HaskellCallbackType TextBufferEndUserActionSignalInfo = TextBufferEndUserActionCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferEndUserActionCallback cb
        cb'' <- mk_TextBufferEndUserActionCallback cb'
        connectSignalFunPtr obj "end-user-action" cb'' connectMode detail

#endif

-- signal TextBuffer::insert-child-anchor
-- | The [insertChildAnchor](#g:signal:insertChildAnchor) signal is emitted to insert a
-- t'GI.Gtk.Objects.TextChildAnchor.TextChildAnchor' in a t'GI.Gtk.Objects.TextBuffer.TextBuffer'.
-- Insertion actually occurs in the default handler.
-- 
-- Note that if your handler runs before the default handler it must
-- not invalidate the /@location@/ iter (or has to revalidate it).
-- The default signal handler revalidates it to be placed after the
-- inserted /@anchor@/.
-- 
-- See also: 'GI.Gtk.Objects.TextBuffer.textBufferInsertChildAnchor'.
type TextBufferInsertChildAnchorCallback =
    Gtk.TextIter.TextIter
    -- ^ /@location@/: position to insert /@anchor@/ in /@textbuffer@/
    -> Gtk.TextChildAnchor.TextChildAnchor
    -- ^ /@anchor@/: the t'GI.Gtk.Objects.TextChildAnchor.TextChildAnchor' to be inserted
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferInsertChildAnchorCallback`@.
noTextBufferInsertChildAnchorCallback :: Maybe TextBufferInsertChildAnchorCallback
noTextBufferInsertChildAnchorCallback :: Maybe TextBufferInsertChildAnchorCallback
noTextBufferInsertChildAnchorCallback = Maybe TextBufferInsertChildAnchorCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferInsertChildAnchorCallback =
    Ptr () ->                               -- object
    Ptr Gtk.TextIter.TextIter ->
    Ptr Gtk.TextChildAnchor.TextChildAnchor ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferInsertChildAnchorCallback`.
foreign import ccall "wrapper"
    mk_TextBufferInsertChildAnchorCallback :: C_TextBufferInsertChildAnchorCallback -> IO (FunPtr C_TextBufferInsertChildAnchorCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferInsertChildAnchor :: MonadIO m => TextBufferInsertChildAnchorCallback -> m (GClosure C_TextBufferInsertChildAnchorCallback)
genClosure_TextBufferInsertChildAnchor :: TextBufferInsertChildAnchorCallback
-> m (GClosure C_TextBufferInsertChildAnchorCallback)
genClosure_TextBufferInsertChildAnchor TextBufferInsertChildAnchorCallback
cb = IO (GClosure C_TextBufferInsertChildAnchorCallback)
-> m (GClosure C_TextBufferInsertChildAnchorCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferInsertChildAnchorCallback)
 -> m (GClosure C_TextBufferInsertChildAnchorCallback))
-> IO (GClosure C_TextBufferInsertChildAnchorCallback)
-> m (GClosure C_TextBufferInsertChildAnchorCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferInsertChildAnchorCallback
cb' = TextBufferInsertChildAnchorCallback
-> C_TextBufferInsertChildAnchorCallback
wrap_TextBufferInsertChildAnchorCallback TextBufferInsertChildAnchorCallback
cb
    C_TextBufferInsertChildAnchorCallback
-> IO (FunPtr C_TextBufferInsertChildAnchorCallback)
mk_TextBufferInsertChildAnchorCallback C_TextBufferInsertChildAnchorCallback
cb' IO (FunPtr C_TextBufferInsertChildAnchorCallback)
-> (FunPtr C_TextBufferInsertChildAnchorCallback
    -> IO (GClosure C_TextBufferInsertChildAnchorCallback))
-> IO (GClosure C_TextBufferInsertChildAnchorCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferInsertChildAnchorCallback
-> IO (GClosure C_TextBufferInsertChildAnchorCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferInsertChildAnchorCallback` into a `C_TextBufferInsertChildAnchorCallback`.
wrap_TextBufferInsertChildAnchorCallback ::
    TextBufferInsertChildAnchorCallback ->
    C_TextBufferInsertChildAnchorCallback
wrap_TextBufferInsertChildAnchorCallback :: TextBufferInsertChildAnchorCallback
-> C_TextBufferInsertChildAnchorCallback
wrap_TextBufferInsertChildAnchorCallback TextBufferInsertChildAnchorCallback
_cb Ptr ()
_ Ptr TextIter
location Ptr TextChildAnchor
anchor Ptr ()
_ = do
    (ManagedPtr TextIter -> TextIter)
-> Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter Ptr TextIter
location ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
location' -> do
        TextChildAnchor
anchor' <- ((ManagedPtr TextChildAnchor -> TextChildAnchor)
-> Ptr TextChildAnchor -> IO TextChildAnchor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TextChildAnchor -> TextChildAnchor
Gtk.TextChildAnchor.TextChildAnchor) Ptr TextChildAnchor
anchor
        TextBufferInsertChildAnchorCallback
_cb  TextIter
location' TextChildAnchor
anchor'


-- | Connect a signal handler for the [insertChildAnchor](#signal:insertChildAnchor) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #insertChildAnchor callback
-- @
-- 
-- 
onTextBufferInsertChildAnchor :: (IsTextBuffer a, MonadIO m) => a -> TextBufferInsertChildAnchorCallback -> m SignalHandlerId
onTextBufferInsertChildAnchor :: a -> TextBufferInsertChildAnchorCallback -> m SignalHandlerId
onTextBufferInsertChildAnchor a
obj TextBufferInsertChildAnchorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferInsertChildAnchorCallback
cb' = TextBufferInsertChildAnchorCallback
-> C_TextBufferInsertChildAnchorCallback
wrap_TextBufferInsertChildAnchorCallback TextBufferInsertChildAnchorCallback
cb
    FunPtr C_TextBufferInsertChildAnchorCallback
cb'' <- C_TextBufferInsertChildAnchorCallback
-> IO (FunPtr C_TextBufferInsertChildAnchorCallback)
mk_TextBufferInsertChildAnchorCallback C_TextBufferInsertChildAnchorCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferInsertChildAnchorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"insert-child-anchor" FunPtr C_TextBufferInsertChildAnchorCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [insertChildAnchor](#signal:insertChildAnchor) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #insertChildAnchor callback
-- @
-- 
-- 
afterTextBufferInsertChildAnchor :: (IsTextBuffer a, MonadIO m) => a -> TextBufferInsertChildAnchorCallback -> m SignalHandlerId
afterTextBufferInsertChildAnchor :: a -> TextBufferInsertChildAnchorCallback -> m SignalHandlerId
afterTextBufferInsertChildAnchor a
obj TextBufferInsertChildAnchorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferInsertChildAnchorCallback
cb' = TextBufferInsertChildAnchorCallback
-> C_TextBufferInsertChildAnchorCallback
wrap_TextBufferInsertChildAnchorCallback TextBufferInsertChildAnchorCallback
cb
    FunPtr C_TextBufferInsertChildAnchorCallback
cb'' <- C_TextBufferInsertChildAnchorCallback
-> IO (FunPtr C_TextBufferInsertChildAnchorCallback)
mk_TextBufferInsertChildAnchorCallback C_TextBufferInsertChildAnchorCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferInsertChildAnchorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"insert-child-anchor" FunPtr C_TextBufferInsertChildAnchorCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferInsertChildAnchorSignalInfo
instance SignalInfo TextBufferInsertChildAnchorSignalInfo where
    type HaskellCallbackType TextBufferInsertChildAnchorSignalInfo = TextBufferInsertChildAnchorCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferInsertChildAnchorCallback cb
        cb'' <- mk_TextBufferInsertChildAnchorCallback cb'
        connectSignalFunPtr obj "insert-child-anchor" cb'' connectMode detail

#endif

-- signal TextBuffer::insert-pixbuf
-- | The [insertPixbuf](#g:signal:insertPixbuf) signal is emitted to insert a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf'
-- in a t'GI.Gtk.Objects.TextBuffer.TextBuffer'. Insertion actually occurs in the default handler.
-- 
-- Note that if your handler runs before the default handler it must not
-- invalidate the /@location@/ iter (or has to revalidate it).
-- The default signal handler revalidates it to be placed after the
-- inserted /@pixbuf@/.
-- 
-- See also: 'GI.Gtk.Objects.TextBuffer.textBufferInsertPixbuf'.
type TextBufferInsertPixbufCallback =
    Gtk.TextIter.TextIter
    -- ^ /@location@/: position to insert /@pixbuf@/ in /@textbuffer@/
    -> GdkPixbuf.Pixbuf.Pixbuf
    -- ^ /@pixbuf@/: the t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' to be inserted
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferInsertPixbufCallback`@.
noTextBufferInsertPixbufCallback :: Maybe TextBufferInsertPixbufCallback
noTextBufferInsertPixbufCallback :: Maybe TextBufferInsertPixbufCallback
noTextBufferInsertPixbufCallback = Maybe TextBufferInsertPixbufCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferInsertPixbufCallback =
    Ptr () ->                               -- object
    Ptr Gtk.TextIter.TextIter ->
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferInsertPixbufCallback`.
foreign import ccall "wrapper"
    mk_TextBufferInsertPixbufCallback :: C_TextBufferInsertPixbufCallback -> IO (FunPtr C_TextBufferInsertPixbufCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferInsertPixbuf :: MonadIO m => TextBufferInsertPixbufCallback -> m (GClosure C_TextBufferInsertPixbufCallback)
genClosure_TextBufferInsertPixbuf :: TextBufferInsertPixbufCallback
-> m (GClosure C_TextBufferInsertPixbufCallback)
genClosure_TextBufferInsertPixbuf TextBufferInsertPixbufCallback
cb = IO (GClosure C_TextBufferInsertPixbufCallback)
-> m (GClosure C_TextBufferInsertPixbufCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferInsertPixbufCallback)
 -> m (GClosure C_TextBufferInsertPixbufCallback))
-> IO (GClosure C_TextBufferInsertPixbufCallback)
-> m (GClosure C_TextBufferInsertPixbufCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferInsertPixbufCallback
cb' = TextBufferInsertPixbufCallback -> C_TextBufferInsertPixbufCallback
wrap_TextBufferInsertPixbufCallback TextBufferInsertPixbufCallback
cb
    C_TextBufferInsertPixbufCallback
-> IO (FunPtr C_TextBufferInsertPixbufCallback)
mk_TextBufferInsertPixbufCallback C_TextBufferInsertPixbufCallback
cb' IO (FunPtr C_TextBufferInsertPixbufCallback)
-> (FunPtr C_TextBufferInsertPixbufCallback
    -> IO (GClosure C_TextBufferInsertPixbufCallback))
-> IO (GClosure C_TextBufferInsertPixbufCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferInsertPixbufCallback
-> IO (GClosure C_TextBufferInsertPixbufCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferInsertPixbufCallback` into a `C_TextBufferInsertPixbufCallback`.
wrap_TextBufferInsertPixbufCallback ::
    TextBufferInsertPixbufCallback ->
    C_TextBufferInsertPixbufCallback
wrap_TextBufferInsertPixbufCallback :: TextBufferInsertPixbufCallback -> C_TextBufferInsertPixbufCallback
wrap_TextBufferInsertPixbufCallback TextBufferInsertPixbufCallback
_cb Ptr ()
_ Ptr TextIter
location Ptr Pixbuf
pixbuf Ptr ()
_ = do
    (ManagedPtr TextIter -> TextIter)
-> Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter Ptr TextIter
location ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
location' -> do
        Pixbuf
pixbuf' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
pixbuf
        TextBufferInsertPixbufCallback
_cb  TextIter
location' Pixbuf
pixbuf'


-- | Connect a signal handler for the [insertPixbuf](#signal:insertPixbuf) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #insertPixbuf callback
-- @
-- 
-- 
onTextBufferInsertPixbuf :: (IsTextBuffer a, MonadIO m) => a -> TextBufferInsertPixbufCallback -> m SignalHandlerId
onTextBufferInsertPixbuf :: a -> TextBufferInsertPixbufCallback -> m SignalHandlerId
onTextBufferInsertPixbuf a
obj TextBufferInsertPixbufCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferInsertPixbufCallback
cb' = TextBufferInsertPixbufCallback -> C_TextBufferInsertPixbufCallback
wrap_TextBufferInsertPixbufCallback TextBufferInsertPixbufCallback
cb
    FunPtr C_TextBufferInsertPixbufCallback
cb'' <- C_TextBufferInsertPixbufCallback
-> IO (FunPtr C_TextBufferInsertPixbufCallback)
mk_TextBufferInsertPixbufCallback C_TextBufferInsertPixbufCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferInsertPixbufCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"insert-pixbuf" FunPtr C_TextBufferInsertPixbufCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [insertPixbuf](#signal:insertPixbuf) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #insertPixbuf callback
-- @
-- 
-- 
afterTextBufferInsertPixbuf :: (IsTextBuffer a, MonadIO m) => a -> TextBufferInsertPixbufCallback -> m SignalHandlerId
afterTextBufferInsertPixbuf :: a -> TextBufferInsertPixbufCallback -> m SignalHandlerId
afterTextBufferInsertPixbuf a
obj TextBufferInsertPixbufCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferInsertPixbufCallback
cb' = TextBufferInsertPixbufCallback -> C_TextBufferInsertPixbufCallback
wrap_TextBufferInsertPixbufCallback TextBufferInsertPixbufCallback
cb
    FunPtr C_TextBufferInsertPixbufCallback
cb'' <- C_TextBufferInsertPixbufCallback
-> IO (FunPtr C_TextBufferInsertPixbufCallback)
mk_TextBufferInsertPixbufCallback C_TextBufferInsertPixbufCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferInsertPixbufCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"insert-pixbuf" FunPtr C_TextBufferInsertPixbufCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferInsertPixbufSignalInfo
instance SignalInfo TextBufferInsertPixbufSignalInfo where
    type HaskellCallbackType TextBufferInsertPixbufSignalInfo = TextBufferInsertPixbufCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferInsertPixbufCallback cb
        cb'' <- mk_TextBufferInsertPixbufCallback cb'
        connectSignalFunPtr obj "insert-pixbuf" cb'' connectMode detail

#endif

-- signal TextBuffer::insert-text
-- | The [insertText](#g:signal:insertText) signal is emitted to insert text in a t'GI.Gtk.Objects.TextBuffer.TextBuffer'.
-- Insertion actually occurs in the default handler.
-- 
-- Note that if your handler runs before the default handler it must not
-- invalidate the /@location@/ iter (or has to revalidate it).
-- The default signal handler revalidates it to point to the end of the
-- inserted text.
-- 
-- See also:
-- 'GI.Gtk.Objects.TextBuffer.textBufferInsert',
-- 'GI.Gtk.Objects.TextBuffer.textBufferInsertRange'.
type TextBufferInsertTextCallback =
    Gtk.TextIter.TextIter
    -- ^ /@location@/: position to insert /@text@/ in /@textbuffer@/
    -> T.Text
    -- ^ /@text@/: the UTF-8 text to be inserted
    -> Int32
    -- ^ /@len@/: length of the inserted text in bytes
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferInsertTextCallback`@.
noTextBufferInsertTextCallback :: Maybe TextBufferInsertTextCallback
noTextBufferInsertTextCallback :: Maybe TextBufferInsertTextCallback
noTextBufferInsertTextCallback = Maybe TextBufferInsertTextCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferInsertTextCallback =
    Ptr () ->                               -- object
    Ptr Gtk.TextIter.TextIter ->
    CString ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferInsertTextCallback`.
foreign import ccall "wrapper"
    mk_TextBufferInsertTextCallback :: C_TextBufferInsertTextCallback -> IO (FunPtr C_TextBufferInsertTextCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferInsertText :: MonadIO m => TextBufferInsertTextCallback -> m (GClosure C_TextBufferInsertTextCallback)
genClosure_TextBufferInsertText :: TextBufferInsertTextCallback
-> m (GClosure C_TextBufferInsertTextCallback)
genClosure_TextBufferInsertText TextBufferInsertTextCallback
cb = IO (GClosure C_TextBufferInsertTextCallback)
-> m (GClosure C_TextBufferInsertTextCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferInsertTextCallback)
 -> m (GClosure C_TextBufferInsertTextCallback))
-> IO (GClosure C_TextBufferInsertTextCallback)
-> m (GClosure C_TextBufferInsertTextCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferInsertTextCallback
cb' = TextBufferInsertTextCallback -> C_TextBufferInsertTextCallback
wrap_TextBufferInsertTextCallback TextBufferInsertTextCallback
cb
    C_TextBufferInsertTextCallback
-> IO (FunPtr C_TextBufferInsertTextCallback)
mk_TextBufferInsertTextCallback C_TextBufferInsertTextCallback
cb' IO (FunPtr C_TextBufferInsertTextCallback)
-> (FunPtr C_TextBufferInsertTextCallback
    -> IO (GClosure C_TextBufferInsertTextCallback))
-> IO (GClosure C_TextBufferInsertTextCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferInsertTextCallback
-> IO (GClosure C_TextBufferInsertTextCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferInsertTextCallback` into a `C_TextBufferInsertTextCallback`.
wrap_TextBufferInsertTextCallback ::
    TextBufferInsertTextCallback ->
    C_TextBufferInsertTextCallback
wrap_TextBufferInsertTextCallback :: TextBufferInsertTextCallback -> C_TextBufferInsertTextCallback
wrap_TextBufferInsertTextCallback TextBufferInsertTextCallback
_cb Ptr ()
_ Ptr TextIter
location CString
text Int32
len Ptr ()
_ = do
    (ManagedPtr TextIter -> TextIter)
-> Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter Ptr TextIter
location ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
location' -> do
        Text
text' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
text
        TextBufferInsertTextCallback
_cb  TextIter
location' Text
text' Int32
len


-- | Connect a signal handler for the [insertText](#signal:insertText) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #insertText callback
-- @
-- 
-- 
onTextBufferInsertText :: (IsTextBuffer a, MonadIO m) => a -> TextBufferInsertTextCallback -> m SignalHandlerId
onTextBufferInsertText :: a -> TextBufferInsertTextCallback -> m SignalHandlerId
onTextBufferInsertText a
obj TextBufferInsertTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferInsertTextCallback
cb' = TextBufferInsertTextCallback -> C_TextBufferInsertTextCallback
wrap_TextBufferInsertTextCallback TextBufferInsertTextCallback
cb
    FunPtr C_TextBufferInsertTextCallback
cb'' <- C_TextBufferInsertTextCallback
-> IO (FunPtr C_TextBufferInsertTextCallback)
mk_TextBufferInsertTextCallback C_TextBufferInsertTextCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferInsertTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"insert-text" FunPtr C_TextBufferInsertTextCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [insertText](#signal:insertText) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #insertText callback
-- @
-- 
-- 
afterTextBufferInsertText :: (IsTextBuffer a, MonadIO m) => a -> TextBufferInsertTextCallback -> m SignalHandlerId
afterTextBufferInsertText :: a -> TextBufferInsertTextCallback -> m SignalHandlerId
afterTextBufferInsertText a
obj TextBufferInsertTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferInsertTextCallback
cb' = TextBufferInsertTextCallback -> C_TextBufferInsertTextCallback
wrap_TextBufferInsertTextCallback TextBufferInsertTextCallback
cb
    FunPtr C_TextBufferInsertTextCallback
cb'' <- C_TextBufferInsertTextCallback
-> IO (FunPtr C_TextBufferInsertTextCallback)
mk_TextBufferInsertTextCallback C_TextBufferInsertTextCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferInsertTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"insert-text" FunPtr C_TextBufferInsertTextCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferInsertTextSignalInfo
instance SignalInfo TextBufferInsertTextSignalInfo where
    type HaskellCallbackType TextBufferInsertTextSignalInfo = TextBufferInsertTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferInsertTextCallback cb
        cb'' <- mk_TextBufferInsertTextCallback cb'
        connectSignalFunPtr obj "insert-text" cb'' connectMode detail

#endif

-- signal TextBuffer::mark-deleted
-- | The [markDeleted](#g:signal:markDeleted) signal is emitted as notification
-- after a t'GI.Gtk.Objects.TextMark.TextMark' is deleted.
-- 
-- See also:
-- 'GI.Gtk.Objects.TextBuffer.textBufferDeleteMark'.
type TextBufferMarkDeletedCallback =
    Gtk.TextMark.TextMark
    -- ^ /@mark@/: The mark that was deleted
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferMarkDeletedCallback`@.
noTextBufferMarkDeletedCallback :: Maybe TextBufferMarkDeletedCallback
noTextBufferMarkDeletedCallback :: Maybe TextBufferMarkDeletedCallback
noTextBufferMarkDeletedCallback = Maybe TextBufferMarkDeletedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferMarkDeletedCallback =
    Ptr () ->                               -- object
    Ptr Gtk.TextMark.TextMark ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferMarkDeletedCallback`.
foreign import ccall "wrapper"
    mk_TextBufferMarkDeletedCallback :: C_TextBufferMarkDeletedCallback -> IO (FunPtr C_TextBufferMarkDeletedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferMarkDeleted :: MonadIO m => TextBufferMarkDeletedCallback -> m (GClosure C_TextBufferMarkDeletedCallback)
genClosure_TextBufferMarkDeleted :: TextBufferMarkDeletedCallback
-> m (GClosure C_TextBufferMarkDeletedCallback)
genClosure_TextBufferMarkDeleted TextBufferMarkDeletedCallback
cb = IO (GClosure C_TextBufferMarkDeletedCallback)
-> m (GClosure C_TextBufferMarkDeletedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferMarkDeletedCallback)
 -> m (GClosure C_TextBufferMarkDeletedCallback))
-> IO (GClosure C_TextBufferMarkDeletedCallback)
-> m (GClosure C_TextBufferMarkDeletedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferMarkDeletedCallback
cb' = TextBufferMarkDeletedCallback -> C_TextBufferMarkDeletedCallback
wrap_TextBufferMarkDeletedCallback TextBufferMarkDeletedCallback
cb
    C_TextBufferMarkDeletedCallback
-> IO (FunPtr C_TextBufferMarkDeletedCallback)
mk_TextBufferMarkDeletedCallback C_TextBufferMarkDeletedCallback
cb' IO (FunPtr C_TextBufferMarkDeletedCallback)
-> (FunPtr C_TextBufferMarkDeletedCallback
    -> IO (GClosure C_TextBufferMarkDeletedCallback))
-> IO (GClosure C_TextBufferMarkDeletedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferMarkDeletedCallback
-> IO (GClosure C_TextBufferMarkDeletedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferMarkDeletedCallback` into a `C_TextBufferMarkDeletedCallback`.
wrap_TextBufferMarkDeletedCallback ::
    TextBufferMarkDeletedCallback ->
    C_TextBufferMarkDeletedCallback
wrap_TextBufferMarkDeletedCallback :: TextBufferMarkDeletedCallback -> C_TextBufferMarkDeletedCallback
wrap_TextBufferMarkDeletedCallback TextBufferMarkDeletedCallback
_cb Ptr ()
_ Ptr TextMark
mark Ptr ()
_ = do
    TextMark
mark' <- ((ManagedPtr TextMark -> TextMark) -> Ptr TextMark -> IO TextMark
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TextMark -> TextMark
Gtk.TextMark.TextMark) Ptr TextMark
mark
    TextBufferMarkDeletedCallback
_cb  TextMark
mark'


-- | Connect a signal handler for the [markDeleted](#signal:markDeleted) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #markDeleted callback
-- @
-- 
-- 
onTextBufferMarkDeleted :: (IsTextBuffer a, MonadIO m) => a -> TextBufferMarkDeletedCallback -> m SignalHandlerId
onTextBufferMarkDeleted :: a -> TextBufferMarkDeletedCallback -> m SignalHandlerId
onTextBufferMarkDeleted a
obj TextBufferMarkDeletedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferMarkDeletedCallback
cb' = TextBufferMarkDeletedCallback -> C_TextBufferMarkDeletedCallback
wrap_TextBufferMarkDeletedCallback TextBufferMarkDeletedCallback
cb
    FunPtr C_TextBufferMarkDeletedCallback
cb'' <- C_TextBufferMarkDeletedCallback
-> IO (FunPtr C_TextBufferMarkDeletedCallback)
mk_TextBufferMarkDeletedCallback C_TextBufferMarkDeletedCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferMarkDeletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mark-deleted" FunPtr C_TextBufferMarkDeletedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [markDeleted](#signal:markDeleted) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #markDeleted callback
-- @
-- 
-- 
afterTextBufferMarkDeleted :: (IsTextBuffer a, MonadIO m) => a -> TextBufferMarkDeletedCallback -> m SignalHandlerId
afterTextBufferMarkDeleted :: a -> TextBufferMarkDeletedCallback -> m SignalHandlerId
afterTextBufferMarkDeleted a
obj TextBufferMarkDeletedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferMarkDeletedCallback
cb' = TextBufferMarkDeletedCallback -> C_TextBufferMarkDeletedCallback
wrap_TextBufferMarkDeletedCallback TextBufferMarkDeletedCallback
cb
    FunPtr C_TextBufferMarkDeletedCallback
cb'' <- C_TextBufferMarkDeletedCallback
-> IO (FunPtr C_TextBufferMarkDeletedCallback)
mk_TextBufferMarkDeletedCallback C_TextBufferMarkDeletedCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferMarkDeletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mark-deleted" FunPtr C_TextBufferMarkDeletedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferMarkDeletedSignalInfo
instance SignalInfo TextBufferMarkDeletedSignalInfo where
    type HaskellCallbackType TextBufferMarkDeletedSignalInfo = TextBufferMarkDeletedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferMarkDeletedCallback cb
        cb'' <- mk_TextBufferMarkDeletedCallback cb'
        connectSignalFunPtr obj "mark-deleted" cb'' connectMode detail

#endif

-- signal TextBuffer::mark-set
-- | The [markSet](#g:signal:markSet) signal is emitted as notification
-- after a t'GI.Gtk.Objects.TextMark.TextMark' is set.
-- 
-- See also:
-- 'GI.Gtk.Objects.TextBuffer.textBufferCreateMark',
-- 'GI.Gtk.Objects.TextBuffer.textBufferMoveMark'.
type TextBufferMarkSetCallback =
    Gtk.TextIter.TextIter
    -- ^ /@location@/: The location of /@mark@/ in /@textbuffer@/
    -> Gtk.TextMark.TextMark
    -- ^ /@mark@/: The mark that is set
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferMarkSetCallback`@.
noTextBufferMarkSetCallback :: Maybe TextBufferMarkSetCallback
noTextBufferMarkSetCallback :: Maybe TextBufferMarkSetCallback
noTextBufferMarkSetCallback = Maybe TextBufferMarkSetCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferMarkSetCallback =
    Ptr () ->                               -- object
    Ptr Gtk.TextIter.TextIter ->
    Ptr Gtk.TextMark.TextMark ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferMarkSetCallback`.
foreign import ccall "wrapper"
    mk_TextBufferMarkSetCallback :: C_TextBufferMarkSetCallback -> IO (FunPtr C_TextBufferMarkSetCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferMarkSet :: MonadIO m => TextBufferMarkSetCallback -> m (GClosure C_TextBufferMarkSetCallback)
genClosure_TextBufferMarkSet :: TextBufferMarkSetCallback
-> m (GClosure C_TextBufferMarkSetCallback)
genClosure_TextBufferMarkSet TextBufferMarkSetCallback
cb = IO (GClosure C_TextBufferMarkSetCallback)
-> m (GClosure C_TextBufferMarkSetCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferMarkSetCallback)
 -> m (GClosure C_TextBufferMarkSetCallback))
-> IO (GClosure C_TextBufferMarkSetCallback)
-> m (GClosure C_TextBufferMarkSetCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferMarkSetCallback
cb' = TextBufferMarkSetCallback -> C_TextBufferMarkSetCallback
wrap_TextBufferMarkSetCallback TextBufferMarkSetCallback
cb
    C_TextBufferMarkSetCallback
-> IO (FunPtr C_TextBufferMarkSetCallback)
mk_TextBufferMarkSetCallback C_TextBufferMarkSetCallback
cb' IO (FunPtr C_TextBufferMarkSetCallback)
-> (FunPtr C_TextBufferMarkSetCallback
    -> IO (GClosure C_TextBufferMarkSetCallback))
-> IO (GClosure C_TextBufferMarkSetCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferMarkSetCallback
-> IO (GClosure C_TextBufferMarkSetCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferMarkSetCallback` into a `C_TextBufferMarkSetCallback`.
wrap_TextBufferMarkSetCallback ::
    TextBufferMarkSetCallback ->
    C_TextBufferMarkSetCallback
wrap_TextBufferMarkSetCallback :: TextBufferMarkSetCallback -> C_TextBufferMarkSetCallback
wrap_TextBufferMarkSetCallback TextBufferMarkSetCallback
_cb Ptr ()
_ Ptr TextIter
location Ptr TextMark
mark Ptr ()
_ = do
    (ManagedPtr TextIter -> TextIter)
-> Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter Ptr TextIter
location ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
location' -> do
        TextMark
mark' <- ((ManagedPtr TextMark -> TextMark) -> Ptr TextMark -> IO TextMark
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TextMark -> TextMark
Gtk.TextMark.TextMark) Ptr TextMark
mark
        TextBufferMarkSetCallback
_cb  TextIter
location' TextMark
mark'


-- | Connect a signal handler for the [markSet](#signal:markSet) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #markSet callback
-- @
-- 
-- 
onTextBufferMarkSet :: (IsTextBuffer a, MonadIO m) => a -> TextBufferMarkSetCallback -> m SignalHandlerId
onTextBufferMarkSet :: a -> TextBufferMarkSetCallback -> m SignalHandlerId
onTextBufferMarkSet a
obj TextBufferMarkSetCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferMarkSetCallback
cb' = TextBufferMarkSetCallback -> C_TextBufferMarkSetCallback
wrap_TextBufferMarkSetCallback TextBufferMarkSetCallback
cb
    FunPtr C_TextBufferMarkSetCallback
cb'' <- C_TextBufferMarkSetCallback
-> IO (FunPtr C_TextBufferMarkSetCallback)
mk_TextBufferMarkSetCallback C_TextBufferMarkSetCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferMarkSetCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mark-set" FunPtr C_TextBufferMarkSetCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [markSet](#signal:markSet) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #markSet callback
-- @
-- 
-- 
afterTextBufferMarkSet :: (IsTextBuffer a, MonadIO m) => a -> TextBufferMarkSetCallback -> m SignalHandlerId
afterTextBufferMarkSet :: a -> TextBufferMarkSetCallback -> m SignalHandlerId
afterTextBufferMarkSet a
obj TextBufferMarkSetCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferMarkSetCallback
cb' = TextBufferMarkSetCallback -> C_TextBufferMarkSetCallback
wrap_TextBufferMarkSetCallback TextBufferMarkSetCallback
cb
    FunPtr C_TextBufferMarkSetCallback
cb'' <- C_TextBufferMarkSetCallback
-> IO (FunPtr C_TextBufferMarkSetCallback)
mk_TextBufferMarkSetCallback C_TextBufferMarkSetCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferMarkSetCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mark-set" FunPtr C_TextBufferMarkSetCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferMarkSetSignalInfo
instance SignalInfo TextBufferMarkSetSignalInfo where
    type HaskellCallbackType TextBufferMarkSetSignalInfo = TextBufferMarkSetCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferMarkSetCallback cb
        cb'' <- mk_TextBufferMarkSetCallback cb'
        connectSignalFunPtr obj "mark-set" cb'' connectMode detail

#endif

-- signal TextBuffer::modified-changed
-- | The [modifiedChanged](#g:signal:modifiedChanged) signal is emitted when the modified bit of a
-- t'GI.Gtk.Objects.TextBuffer.TextBuffer' flips.
-- 
-- See also:
-- 'GI.Gtk.Objects.TextBuffer.textBufferSetModified'.
type TextBufferModifiedChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferModifiedChangedCallback`@.
noTextBufferModifiedChangedCallback :: Maybe TextBufferModifiedChangedCallback
noTextBufferModifiedChangedCallback :: Maybe (IO ())
noTextBufferModifiedChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferModifiedChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferModifiedChangedCallback`.
foreign import ccall "wrapper"
    mk_TextBufferModifiedChangedCallback :: C_TextBufferModifiedChangedCallback -> IO (FunPtr C_TextBufferModifiedChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferModifiedChanged :: MonadIO m => TextBufferModifiedChangedCallback -> m (GClosure C_TextBufferModifiedChangedCallback)
genClosure_TextBufferModifiedChanged :: IO () -> m (GClosure C_TextBufferBeginUserActionCallback)
genClosure_TextBufferModifiedChanged IO ()
cb = IO (GClosure C_TextBufferBeginUserActionCallback)
-> m (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferBeginUserActionCallback)
 -> m (GClosure C_TextBufferBeginUserActionCallback))
-> IO (GClosure C_TextBufferBeginUserActionCallback)
-> m (GClosure C_TextBufferBeginUserActionCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferModifiedChangedCallback IO ()
cb
    C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferModifiedChangedCallback C_TextBufferBeginUserActionCallback
cb' IO (FunPtr C_TextBufferBeginUserActionCallback)
-> (FunPtr C_TextBufferBeginUserActionCallback
    -> IO (GClosure C_TextBufferBeginUserActionCallback))
-> IO (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferBeginUserActionCallback
-> IO (GClosure C_TextBufferBeginUserActionCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferModifiedChangedCallback` into a `C_TextBufferModifiedChangedCallback`.
wrap_TextBufferModifiedChangedCallback ::
    TextBufferModifiedChangedCallback ->
    C_TextBufferModifiedChangedCallback
wrap_TextBufferModifiedChangedCallback :: IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferModifiedChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [modifiedChanged](#signal:modifiedChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #modifiedChanged callback
-- @
-- 
-- 
onTextBufferModifiedChanged :: (IsTextBuffer a, MonadIO m) => a -> TextBufferModifiedChangedCallback -> m SignalHandlerId
onTextBufferModifiedChanged :: a -> IO () -> m SignalHandlerId
onTextBufferModifiedChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferModifiedChangedCallback IO ()
cb
    FunPtr C_TextBufferBeginUserActionCallback
cb'' <- C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferModifiedChangedCallback C_TextBufferBeginUserActionCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferBeginUserActionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"modified-changed" FunPtr C_TextBufferBeginUserActionCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [modifiedChanged](#signal:modifiedChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #modifiedChanged callback
-- @
-- 
-- 
afterTextBufferModifiedChanged :: (IsTextBuffer a, MonadIO m) => a -> TextBufferModifiedChangedCallback -> m SignalHandlerId
afterTextBufferModifiedChanged :: a -> IO () -> m SignalHandlerId
afterTextBufferModifiedChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferBeginUserActionCallback
cb' = IO () -> C_TextBufferBeginUserActionCallback
wrap_TextBufferModifiedChangedCallback IO ()
cb
    FunPtr C_TextBufferBeginUserActionCallback
cb'' <- C_TextBufferBeginUserActionCallback
-> IO (FunPtr C_TextBufferBeginUserActionCallback)
mk_TextBufferModifiedChangedCallback C_TextBufferBeginUserActionCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferBeginUserActionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"modified-changed" FunPtr C_TextBufferBeginUserActionCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferModifiedChangedSignalInfo
instance SignalInfo TextBufferModifiedChangedSignalInfo where
    type HaskellCallbackType TextBufferModifiedChangedSignalInfo = TextBufferModifiedChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferModifiedChangedCallback cb
        cb'' <- mk_TextBufferModifiedChangedCallback cb'
        connectSignalFunPtr obj "modified-changed" cb'' connectMode detail

#endif

-- signal TextBuffer::paste-done
-- | The paste-done signal is emitted after paste operation has been completed.
-- This is useful to properly scroll the view to the end of the pasted text.
-- See 'GI.Gtk.Objects.TextBuffer.textBufferPasteClipboard' for more details.
-- 
-- /Since: 2.16/
type TextBufferPasteDoneCallback =
    Gtk.Clipboard.Clipboard
    -- ^ /@clipboard@/: the t'GI.Gtk.Objects.Clipboard.Clipboard' pasted from
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferPasteDoneCallback`@.
noTextBufferPasteDoneCallback :: Maybe TextBufferPasteDoneCallback
noTextBufferPasteDoneCallback :: Maybe TextBufferPasteDoneCallback
noTextBufferPasteDoneCallback = Maybe TextBufferPasteDoneCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferPasteDoneCallback =
    Ptr () ->                               -- object
    Ptr Gtk.Clipboard.Clipboard ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferPasteDoneCallback`.
foreign import ccall "wrapper"
    mk_TextBufferPasteDoneCallback :: C_TextBufferPasteDoneCallback -> IO (FunPtr C_TextBufferPasteDoneCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferPasteDone :: MonadIO m => TextBufferPasteDoneCallback -> m (GClosure C_TextBufferPasteDoneCallback)
genClosure_TextBufferPasteDone :: TextBufferPasteDoneCallback
-> m (GClosure C_TextBufferPasteDoneCallback)
genClosure_TextBufferPasteDone TextBufferPasteDoneCallback
cb = IO (GClosure C_TextBufferPasteDoneCallback)
-> m (GClosure C_TextBufferPasteDoneCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferPasteDoneCallback)
 -> m (GClosure C_TextBufferPasteDoneCallback))
-> IO (GClosure C_TextBufferPasteDoneCallback)
-> m (GClosure C_TextBufferPasteDoneCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferPasteDoneCallback
cb' = TextBufferPasteDoneCallback -> C_TextBufferPasteDoneCallback
wrap_TextBufferPasteDoneCallback TextBufferPasteDoneCallback
cb
    C_TextBufferPasteDoneCallback
-> IO (FunPtr C_TextBufferPasteDoneCallback)
mk_TextBufferPasteDoneCallback C_TextBufferPasteDoneCallback
cb' IO (FunPtr C_TextBufferPasteDoneCallback)
-> (FunPtr C_TextBufferPasteDoneCallback
    -> IO (GClosure C_TextBufferPasteDoneCallback))
-> IO (GClosure C_TextBufferPasteDoneCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferPasteDoneCallback
-> IO (GClosure C_TextBufferPasteDoneCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferPasteDoneCallback` into a `C_TextBufferPasteDoneCallback`.
wrap_TextBufferPasteDoneCallback ::
    TextBufferPasteDoneCallback ->
    C_TextBufferPasteDoneCallback
wrap_TextBufferPasteDoneCallback :: TextBufferPasteDoneCallback -> C_TextBufferPasteDoneCallback
wrap_TextBufferPasteDoneCallback TextBufferPasteDoneCallback
_cb Ptr ()
_ Ptr Clipboard
clipboard Ptr ()
_ = do
    Clipboard
clipboard' <- ((ManagedPtr Clipboard -> Clipboard)
-> Ptr Clipboard -> IO Clipboard
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Clipboard -> Clipboard
Gtk.Clipboard.Clipboard) Ptr Clipboard
clipboard
    TextBufferPasteDoneCallback
_cb  Clipboard
clipboard'


-- | Connect a signal handler for the [pasteDone](#signal:pasteDone) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #pasteDone callback
-- @
-- 
-- 
onTextBufferPasteDone :: (IsTextBuffer a, MonadIO m) => a -> TextBufferPasteDoneCallback -> m SignalHandlerId
onTextBufferPasteDone :: a -> TextBufferPasteDoneCallback -> m SignalHandlerId
onTextBufferPasteDone a
obj TextBufferPasteDoneCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferPasteDoneCallback
cb' = TextBufferPasteDoneCallback -> C_TextBufferPasteDoneCallback
wrap_TextBufferPasteDoneCallback TextBufferPasteDoneCallback
cb
    FunPtr C_TextBufferPasteDoneCallback
cb'' <- C_TextBufferPasteDoneCallback
-> IO (FunPtr C_TextBufferPasteDoneCallback)
mk_TextBufferPasteDoneCallback C_TextBufferPasteDoneCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferPasteDoneCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"paste-done" FunPtr C_TextBufferPasteDoneCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [pasteDone](#signal:pasteDone) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #pasteDone callback
-- @
-- 
-- 
afterTextBufferPasteDone :: (IsTextBuffer a, MonadIO m) => a -> TextBufferPasteDoneCallback -> m SignalHandlerId
afterTextBufferPasteDone :: a -> TextBufferPasteDoneCallback -> m SignalHandlerId
afterTextBufferPasteDone a
obj TextBufferPasteDoneCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferPasteDoneCallback
cb' = TextBufferPasteDoneCallback -> C_TextBufferPasteDoneCallback
wrap_TextBufferPasteDoneCallback TextBufferPasteDoneCallback
cb
    FunPtr C_TextBufferPasteDoneCallback
cb'' <- C_TextBufferPasteDoneCallback
-> IO (FunPtr C_TextBufferPasteDoneCallback)
mk_TextBufferPasteDoneCallback C_TextBufferPasteDoneCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferPasteDoneCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"paste-done" FunPtr C_TextBufferPasteDoneCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferPasteDoneSignalInfo
instance SignalInfo TextBufferPasteDoneSignalInfo where
    type HaskellCallbackType TextBufferPasteDoneSignalInfo = TextBufferPasteDoneCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferPasteDoneCallback cb
        cb'' <- mk_TextBufferPasteDoneCallback cb'
        connectSignalFunPtr obj "paste-done" cb'' connectMode detail

#endif

-- signal TextBuffer::remove-tag
-- | The [removeTag](#g:signal:removeTag) signal is emitted to remove all occurrences of /@tag@/ from
-- a range of text in a t'GI.Gtk.Objects.TextBuffer.TextBuffer'.
-- Removal actually occurs in the default handler.
-- 
-- Note that if your handler runs before the default handler it must not
-- invalidate the /@start@/ and /@end@/ iters (or has to revalidate them).
-- 
-- See also:
-- 'GI.Gtk.Objects.TextBuffer.textBufferRemoveTag'.
type TextBufferRemoveTagCallback =
    Gtk.TextTag.TextTag
    -- ^ /@tag@/: the tag to be removed
    -> Gtk.TextIter.TextIter
    -- ^ /@start@/: the start of the range the tag is removed from
    -> Gtk.TextIter.TextIter
    -- ^ /@end@/: the end of the range the tag is removed from
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextBufferRemoveTagCallback`@.
noTextBufferRemoveTagCallback :: Maybe TextBufferRemoveTagCallback
noTextBufferRemoveTagCallback :: Maybe TextBufferApplyTagCallback
noTextBufferRemoveTagCallback = Maybe TextBufferApplyTagCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_TextBufferRemoveTagCallback =
    Ptr () ->                               -- object
    Ptr Gtk.TextTag.TextTag ->
    Ptr Gtk.TextIter.TextIter ->
    Ptr Gtk.TextIter.TextIter ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_TextBufferRemoveTagCallback`.
foreign import ccall "wrapper"
    mk_TextBufferRemoveTagCallback :: C_TextBufferRemoveTagCallback -> IO (FunPtr C_TextBufferRemoveTagCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_TextBufferRemoveTag :: MonadIO m => TextBufferRemoveTagCallback -> m (GClosure C_TextBufferRemoveTagCallback)
genClosure_TextBufferRemoveTag :: TextBufferApplyTagCallback
-> m (GClosure C_TextBufferApplyTagCallback)
genClosure_TextBufferRemoveTag TextBufferApplyTagCallback
cb = IO (GClosure C_TextBufferApplyTagCallback)
-> m (GClosure C_TextBufferApplyTagCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextBufferApplyTagCallback)
 -> m (GClosure C_TextBufferApplyTagCallback))
-> IO (GClosure C_TextBufferApplyTagCallback)
-> m (GClosure C_TextBufferApplyTagCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferApplyTagCallback
cb' = TextBufferApplyTagCallback -> C_TextBufferApplyTagCallback
wrap_TextBufferRemoveTagCallback TextBufferApplyTagCallback
cb
    C_TextBufferApplyTagCallback
-> IO (FunPtr C_TextBufferApplyTagCallback)
mk_TextBufferRemoveTagCallback C_TextBufferApplyTagCallback
cb' IO (FunPtr C_TextBufferApplyTagCallback)
-> (FunPtr C_TextBufferApplyTagCallback
    -> IO (GClosure C_TextBufferApplyTagCallback))
-> IO (GClosure C_TextBufferApplyTagCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextBufferApplyTagCallback
-> IO (GClosure C_TextBufferApplyTagCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBufferRemoveTagCallback` into a `C_TextBufferRemoveTagCallback`.
wrap_TextBufferRemoveTagCallback ::
    TextBufferRemoveTagCallback ->
    C_TextBufferRemoveTagCallback
wrap_TextBufferRemoveTagCallback :: TextBufferApplyTagCallback -> C_TextBufferApplyTagCallback
wrap_TextBufferRemoveTagCallback TextBufferApplyTagCallback
_cb Ptr ()
_ Ptr TextTag
tag Ptr TextIter
start Ptr TextIter
end Ptr ()
_ = do
    TextTag
tag' <- ((ManagedPtr TextTag -> TextTag) -> Ptr TextTag -> IO TextTag
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TextTag -> TextTag
Gtk.TextTag.TextTag) Ptr TextTag
tag
    (ManagedPtr TextIter -> TextIter)
-> Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter Ptr TextIter
start ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
start' -> do
        (ManagedPtr TextIter -> TextIter)
-> Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter Ptr TextIter
end ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
end' -> do
            TextBufferApplyTagCallback
_cb  TextTag
tag' TextIter
start' TextIter
end'


-- | Connect a signal handler for the [removeTag](#signal:removeTag) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' textBuffer #removeTag callback
-- @
-- 
-- 
onTextBufferRemoveTag :: (IsTextBuffer a, MonadIO m) => a -> TextBufferRemoveTagCallback -> m SignalHandlerId
onTextBufferRemoveTag :: a -> TextBufferApplyTagCallback -> m SignalHandlerId
onTextBufferRemoveTag a
obj TextBufferApplyTagCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferApplyTagCallback
cb' = TextBufferApplyTagCallback -> C_TextBufferApplyTagCallback
wrap_TextBufferRemoveTagCallback TextBufferApplyTagCallback
cb
    FunPtr C_TextBufferApplyTagCallback
cb'' <- C_TextBufferApplyTagCallback
-> IO (FunPtr C_TextBufferApplyTagCallback)
mk_TextBufferRemoveTagCallback C_TextBufferApplyTagCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferApplyTagCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"remove-tag" FunPtr C_TextBufferApplyTagCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [removeTag](#signal:removeTag) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' textBuffer #removeTag callback
-- @
-- 
-- 
afterTextBufferRemoveTag :: (IsTextBuffer a, MonadIO m) => a -> TextBufferRemoveTagCallback -> m SignalHandlerId
afterTextBufferRemoveTag :: a -> TextBufferApplyTagCallback -> m SignalHandlerId
afterTextBufferRemoveTag a
obj TextBufferApplyTagCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextBufferApplyTagCallback
cb' = TextBufferApplyTagCallback -> C_TextBufferApplyTagCallback
wrap_TextBufferRemoveTagCallback TextBufferApplyTagCallback
cb
    FunPtr C_TextBufferApplyTagCallback
cb'' <- C_TextBufferApplyTagCallback
-> IO (FunPtr C_TextBufferApplyTagCallback)
mk_TextBufferRemoveTagCallback C_TextBufferApplyTagCallback
cb'
    a
-> Text
-> FunPtr C_TextBufferApplyTagCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"remove-tag" FunPtr C_TextBufferApplyTagCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferRemoveTagSignalInfo
instance SignalInfo TextBufferRemoveTagSignalInfo where
    type HaskellCallbackType TextBufferRemoveTagSignalInfo = TextBufferRemoveTagCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferRemoveTagCallback cb
        cb'' <- mk_TextBufferRemoveTagCallback cb'
        connectSignalFunPtr obj "remove-tag" cb'' connectMode detail

#endif

-- VVV Prop "copy-target-list"
   -- Type: TInterface (Name {namespace = "Gtk", name = "TargetList"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@copy-target-list@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textBuffer #copyTargetList
-- @
getTextBufferCopyTargetList :: (MonadIO m, IsTextBuffer o) => o -> m Gtk.TargetList.TargetList
getTextBufferCopyTargetList :: o -> m TargetList
getTextBufferCopyTargetList o
obj = IO TargetList -> m TargetList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TargetList -> m TargetList) -> IO TargetList -> m TargetList
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe TargetList) -> IO TargetList
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getTextBufferCopyTargetList" (IO (Maybe TargetList) -> IO TargetList)
-> IO (Maybe TargetList) -> IO TargetList
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr TargetList -> TargetList)
-> IO (Maybe TargetList)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"copy-target-list" ManagedPtr TargetList -> TargetList
Gtk.TargetList.TargetList

#if defined(ENABLE_OVERLOADING)
data TextBufferCopyTargetListPropertyInfo
instance AttrInfo TextBufferCopyTargetListPropertyInfo where
    type AttrAllowedOps TextBufferCopyTargetListPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TextBufferCopyTargetListPropertyInfo = IsTextBuffer
    type AttrSetTypeConstraint TextBufferCopyTargetListPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TextBufferCopyTargetListPropertyInfo = (~) ()
    type AttrTransferType TextBufferCopyTargetListPropertyInfo = ()
    type AttrGetType TextBufferCopyTargetListPropertyInfo = Gtk.TargetList.TargetList
    type AttrLabel TextBufferCopyTargetListPropertyInfo = "copy-target-list"
    type AttrOrigin TextBufferCopyTargetListPropertyInfo = TextBuffer
    attrGet = getTextBufferCopyTargetList
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "cursor-position"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@cursor-position@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textBuffer #cursorPosition
-- @
getTextBufferCursorPosition :: (MonadIO m, IsTextBuffer o) => o -> m Int32
getTextBufferCursorPosition :: o -> m Int32
getTextBufferCursorPosition o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"cursor-position"

#if defined(ENABLE_OVERLOADING)
data TextBufferCursorPositionPropertyInfo
instance AttrInfo TextBufferCursorPositionPropertyInfo where
    type AttrAllowedOps TextBufferCursorPositionPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint TextBufferCursorPositionPropertyInfo = IsTextBuffer
    type AttrSetTypeConstraint TextBufferCursorPositionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TextBufferCursorPositionPropertyInfo = (~) ()
    type AttrTransferType TextBufferCursorPositionPropertyInfo = ()
    type AttrGetType TextBufferCursorPositionPropertyInfo = Int32
    type AttrLabel TextBufferCursorPositionPropertyInfo = "cursor-position"
    type AttrOrigin TextBufferCursorPositionPropertyInfo = TextBuffer
    attrGet = getTextBufferCursorPosition
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "has-selection"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@has-selection@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textBuffer #hasSelection
-- @
getTextBufferHasSelection :: (MonadIO m, IsTextBuffer o) => o -> m Bool
getTextBufferHasSelection :: o -> m Bool
getTextBufferHasSelection o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"has-selection"

#if defined(ENABLE_OVERLOADING)
data TextBufferHasSelectionPropertyInfo
instance AttrInfo TextBufferHasSelectionPropertyInfo where
    type AttrAllowedOps TextBufferHasSelectionPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint TextBufferHasSelectionPropertyInfo = IsTextBuffer
    type AttrSetTypeConstraint TextBufferHasSelectionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TextBufferHasSelectionPropertyInfo = (~) ()
    type AttrTransferType TextBufferHasSelectionPropertyInfo = ()
    type AttrGetType TextBufferHasSelectionPropertyInfo = Bool
    type AttrLabel TextBufferHasSelectionPropertyInfo = "has-selection"
    type AttrOrigin TextBufferHasSelectionPropertyInfo = TextBuffer
    attrGet = getTextBufferHasSelection
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "paste-target-list"
   -- Type: TInterface (Name {namespace = "Gtk", name = "TargetList"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@paste-target-list@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textBuffer #pasteTargetList
-- @
getTextBufferPasteTargetList :: (MonadIO m, IsTextBuffer o) => o -> m Gtk.TargetList.TargetList
getTextBufferPasteTargetList :: o -> m TargetList
getTextBufferPasteTargetList o
obj = IO TargetList -> m TargetList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TargetList -> m TargetList) -> IO TargetList -> m TargetList
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe TargetList) -> IO TargetList
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getTextBufferPasteTargetList" (IO (Maybe TargetList) -> IO TargetList)
-> IO (Maybe TargetList) -> IO TargetList
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr TargetList -> TargetList)
-> IO (Maybe TargetList)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"paste-target-list" ManagedPtr TargetList -> TargetList
Gtk.TargetList.TargetList

#if defined(ENABLE_OVERLOADING)
data TextBufferPasteTargetListPropertyInfo
instance AttrInfo TextBufferPasteTargetListPropertyInfo where
    type AttrAllowedOps TextBufferPasteTargetListPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TextBufferPasteTargetListPropertyInfo = IsTextBuffer
    type AttrSetTypeConstraint TextBufferPasteTargetListPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TextBufferPasteTargetListPropertyInfo = (~) ()
    type AttrTransferType TextBufferPasteTargetListPropertyInfo = ()
    type AttrGetType TextBufferPasteTargetListPropertyInfo = Gtk.TargetList.TargetList
    type AttrLabel TextBufferPasteTargetListPropertyInfo = "paste-target-list"
    type AttrOrigin TextBufferPasteTargetListPropertyInfo = TextBuffer
    attrGet = getTextBufferPasteTargetList
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "tag-table"
   -- Type: TInterface (Name {namespace = "Gtk", name = "TextTagTable"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@tag-table@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textBuffer #tagTable
-- @
getTextBufferTagTable :: (MonadIO m, IsTextBuffer o) => o -> m Gtk.TextTagTable.TextTagTable
getTextBufferTagTable :: o -> m TextTagTable
getTextBufferTagTable o
obj = IO TextTagTable -> m TextTagTable
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextTagTable -> m TextTagTable)
-> IO TextTagTable -> m TextTagTable
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe TextTagTable) -> IO TextTagTable
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getTextBufferTagTable" (IO (Maybe TextTagTable) -> IO TextTagTable)
-> IO (Maybe TextTagTable) -> IO TextTagTable
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr TextTagTable -> TextTagTable)
-> IO (Maybe TextTagTable)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"tag-table" ManagedPtr TextTagTable -> TextTagTable
Gtk.TextTagTable.TextTagTable

-- | Construct a `GValueConstruct` with valid value for the “@tag-table@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextBufferTagTable :: (IsTextBuffer o, MIO.MonadIO m, Gtk.TextTagTable.IsTextTagTable a) => a -> m (GValueConstruct o)
constructTextBufferTagTable :: a -> m (GValueConstruct o)
constructTextBufferTagTable a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"tag-table" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data TextBufferTagTablePropertyInfo
instance AttrInfo TextBufferTagTablePropertyInfo where
    type AttrAllowedOps TextBufferTagTablePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TextBufferTagTablePropertyInfo = IsTextBuffer
    type AttrSetTypeConstraint TextBufferTagTablePropertyInfo = Gtk.TextTagTable.IsTextTagTable
    type AttrTransferTypeConstraint TextBufferTagTablePropertyInfo = Gtk.TextTagTable.IsTextTagTable
    type AttrTransferType TextBufferTagTablePropertyInfo = Gtk.TextTagTable.TextTagTable
    type AttrGetType TextBufferTagTablePropertyInfo = Gtk.TextTagTable.TextTagTable
    type AttrLabel TextBufferTagTablePropertyInfo = "tag-table"
    type AttrOrigin TextBufferTagTablePropertyInfo = TextBuffer
    attrGet = getTextBufferTagTable
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.TextTagTable.TextTagTable v
    attrConstruct = constructTextBufferTagTable
    attrClear = undefined
#endif

-- VVV Prop "text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textBuffer #text
-- @
getTextBufferText :: (MonadIO m, IsTextBuffer o) => o -> m (Maybe T.Text)
getTextBufferText :: o -> m (Maybe Text)
getTextBufferText o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"text"

-- | Set the value of the “@text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' textBuffer [ #text 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextBufferText :: (MonadIO m, IsTextBuffer o) => o -> T.Text -> m ()
setTextBufferText :: o -> Text -> m ()
setTextBufferText o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@text@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextBufferText :: (IsTextBuffer o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructTextBufferText :: Text -> m (GValueConstruct o)
constructTextBufferText Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"text" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@text@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #text
-- @
clearTextBufferText :: (MonadIO m, IsTextBuffer o) => o -> m ()
clearTextBufferText :: o -> m ()
clearTextBufferText o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"text" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data TextBufferTextPropertyInfo
instance AttrInfo TextBufferTextPropertyInfo where
    type AttrAllowedOps TextBufferTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TextBufferTextPropertyInfo = IsTextBuffer
    type AttrSetTypeConstraint TextBufferTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint TextBufferTextPropertyInfo = (~) T.Text
    type AttrTransferType TextBufferTextPropertyInfo = T.Text
    type AttrGetType TextBufferTextPropertyInfo = (Maybe T.Text)
    type AttrLabel TextBufferTextPropertyInfo = "text"
    type AttrOrigin TextBufferTextPropertyInfo = TextBuffer
    attrGet = getTextBufferText
    attrSet = setTextBufferText
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextBufferText
    attrClear = clearTextBufferText
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TextBuffer
type instance O.AttributeList TextBuffer = TextBufferAttributeList
type TextBufferAttributeList = ('[ '("copyTargetList", TextBufferCopyTargetListPropertyInfo), '("cursorPosition", TextBufferCursorPositionPropertyInfo), '("hasSelection", TextBufferHasSelectionPropertyInfo), '("pasteTargetList", TextBufferPasteTargetListPropertyInfo), '("tagTable", TextBufferTagTablePropertyInfo), '("text", TextBufferTextPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
textBufferCopyTargetList :: AttrLabelProxy "copyTargetList"
textBufferCopyTargetList = AttrLabelProxy

textBufferCursorPosition :: AttrLabelProxy "cursorPosition"
textBufferCursorPosition = AttrLabelProxy

textBufferHasSelection :: AttrLabelProxy "hasSelection"
textBufferHasSelection = AttrLabelProxy

textBufferPasteTargetList :: AttrLabelProxy "pasteTargetList"
textBufferPasteTargetList = AttrLabelProxy

textBufferTagTable :: AttrLabelProxy "tagTable"
textBufferTagTable = AttrLabelProxy

textBufferText :: AttrLabelProxy "text"
textBufferText = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TextBuffer = TextBufferSignalList
type TextBufferSignalList = ('[ '("applyTag", TextBufferApplyTagSignalInfo), '("beginUserAction", TextBufferBeginUserActionSignalInfo), '("changed", TextBufferChangedSignalInfo), '("deleteRange", TextBufferDeleteRangeSignalInfo), '("endUserAction", TextBufferEndUserActionSignalInfo), '("insertChildAnchor", TextBufferInsertChildAnchorSignalInfo), '("insertPixbuf", TextBufferInsertPixbufSignalInfo), '("insertText", TextBufferInsertTextSignalInfo), '("markDeleted", TextBufferMarkDeletedSignalInfo), '("markSet", TextBufferMarkSetSignalInfo), '("modifiedChanged", TextBufferModifiedChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("pasteDone", TextBufferPasteDoneSignalInfo), '("removeTag", TextBufferRemoveTagSignalInfo)] :: [(Symbol, *)])

#endif

-- method TextBuffer::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "table"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextTagTable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tag table, or %NULL to create a new one"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "TextBuffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_new" gtk_text_buffer_new :: 
    Ptr Gtk.TextTagTable.TextTagTable ->    -- table : TInterface (Name {namespace = "Gtk", name = "TextTagTable"})
    IO (Ptr TextBuffer)

-- | Creates a new text buffer.
textBufferNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.TextTagTable.IsTextTagTable a) =>
    Maybe (a)
    -- ^ /@table@/: a tag table, or 'P.Nothing' to create a new one
    -> m TextBuffer
    -- ^ __Returns:__ a new text buffer
textBufferNew :: Maybe a -> m TextBuffer
textBufferNew Maybe a
table = IO TextBuffer -> m TextBuffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextBuffer -> m TextBuffer) -> IO TextBuffer -> m TextBuffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextTagTable
maybeTable <- case Maybe a
table of
        Maybe a
Nothing -> Ptr TextTagTable -> IO (Ptr TextTagTable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TextTagTable
forall a. Ptr a
nullPtr
        Just a
jTable -> do
            Ptr TextTagTable
jTable' <- a -> IO (Ptr TextTagTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jTable
            Ptr TextTagTable -> IO (Ptr TextTagTable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TextTagTable
jTable'
    Ptr TextBuffer
result <- Ptr TextTagTable -> IO (Ptr TextBuffer)
gtk_text_buffer_new Ptr TextTagTable
maybeTable
    Text -> Ptr TextBuffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textBufferNew" Ptr TextBuffer
result
    TextBuffer
result' <- ((ManagedPtr TextBuffer -> TextBuffer)
-> Ptr TextBuffer -> IO TextBuffer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr TextBuffer -> TextBuffer
TextBuffer) Ptr TextBuffer
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
table a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    TextBuffer -> IO TextBuffer
forall (m :: * -> *) a. Monad m => a -> m a
return TextBuffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TextBuffer::add_mark
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mark"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextMark" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mark to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "where"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to place mark"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_add_mark" gtk_text_buffer_add_mark :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gtk.TextMark.TextMark ->            -- mark : TInterface (Name {namespace = "Gtk", name = "TextMark"})
    Ptr Gtk.TextIter.TextIter ->            -- where : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO ()

-- | Adds the mark at position /@where@/. The mark must not be added to
-- another buffer, and if its name is not 'P.Nothing' then there must not
-- be another mark in the buffer with the same name.
-- 
-- Emits the [markSet]("GI.Gtk.Objects.TextBuffer#g:signal:markSet") signal as notification of the mark\'s
-- initial placement.
-- 
-- /Since: 2.12/
textBufferAddMark ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a, Gtk.TextMark.IsTextMark b) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> b
    -- ^ /@mark@/: the mark to add
    -> Gtk.TextIter.TextIter
    -- ^ /@where@/: location to place mark
    -> m ()
textBufferAddMark :: a -> b -> TextIter -> m ()
textBufferAddMark a
buffer b
mark TextIter
where_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr TextMark
mark' <- b -> IO (Ptr TextMark)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
mark
    Ptr TextIter
where_' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
where_
    Ptr TextBuffer -> Ptr TextMark -> Ptr TextIter -> IO ()
gtk_text_buffer_add_mark Ptr TextBuffer
buffer' Ptr TextMark
mark' Ptr TextIter
where_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
mark
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
where_
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferAddMarkMethodInfo
instance (signature ~ (b -> Gtk.TextIter.TextIter -> m ()), MonadIO m, IsTextBuffer a, Gtk.TextMark.IsTextMark b) => O.MethodInfo TextBufferAddMarkMethodInfo a signature where
    overloadedMethod = textBufferAddMark

#endif

-- method TextBuffer::add_selection_clipboard
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkClipboard" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_add_selection_clipboard" gtk_text_buffer_add_selection_clipboard :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gtk.Clipboard.Clipboard ->          -- clipboard : TInterface (Name {namespace = "Gtk", name = "Clipboard"})
    IO ()

-- | Adds /@clipboard@/ to the list of clipboards in which the selection
-- contents of /@buffer@/ are available. In most cases, /@clipboard@/ will be
-- the t'GI.Gtk.Objects.Clipboard.Clipboard' of type @/GDK_SELECTION_PRIMARY/@ for a view of /@buffer@/.
textBufferAddSelectionClipboard ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a, Gtk.Clipboard.IsClipboard b) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> b
    -- ^ /@clipboard@/: a t'GI.Gtk.Objects.Clipboard.Clipboard'
    -> m ()
textBufferAddSelectionClipboard :: a -> b -> m ()
textBufferAddSelectionClipboard a
buffer b
clipboard = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr Clipboard
clipboard' <- b -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
clipboard
    Ptr TextBuffer -> Ptr Clipboard -> IO ()
gtk_text_buffer_add_selection_clipboard Ptr TextBuffer
buffer' Ptr Clipboard
clipboard'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
clipboard
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferAddSelectionClipboardMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTextBuffer a, Gtk.Clipboard.IsClipboard b) => O.MethodInfo TextBufferAddSelectionClipboardMethodInfo a signature where
    overloadedMethod = textBufferAddSelectionClipboard

#endif

-- method TextBuffer::apply_tag
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextTag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextTag" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "one bound of range to be tagged"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "other bound of range to be tagged"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_apply_tag" gtk_text_buffer_apply_tag :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gtk.TextTag.TextTag ->              -- tag : TInterface (Name {namespace = "Gtk", name = "TextTag"})
    Ptr Gtk.TextIter.TextIter ->            -- start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO ()

-- | Emits the “apply-tag” signal on /@buffer@/. The default
-- handler for the signal applies /@tag@/ to the given range.
-- /@start@/ and /@end@/ do not have to be in order.
textBufferApplyTag ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a, Gtk.TextTag.IsTextTag b) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> b
    -- ^ /@tag@/: a t'GI.Gtk.Objects.TextTag.TextTag'
    -> Gtk.TextIter.TextIter
    -- ^ /@start@/: one bound of range to be tagged
    -> Gtk.TextIter.TextIter
    -- ^ /@end@/: other bound of range to be tagged
    -> m ()
textBufferApplyTag :: a -> b -> TextIter -> TextIter -> m ()
textBufferApplyTag a
buffer b
tag TextIter
start TextIter
end = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr TextTag
tag' <- b -> IO (Ptr TextTag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
tag
    Ptr TextIter
start' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
start
    Ptr TextIter
end' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
end
    Ptr TextBuffer
-> Ptr TextTag -> Ptr TextIter -> Ptr TextIter -> IO ()
gtk_text_buffer_apply_tag Ptr TextBuffer
buffer' Ptr TextTag
tag' Ptr TextIter
start' Ptr TextIter
end'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
tag
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
start
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
end
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferApplyTagMethodInfo
instance (signature ~ (b -> Gtk.TextIter.TextIter -> Gtk.TextIter.TextIter -> m ()), MonadIO m, IsTextBuffer a, Gtk.TextTag.IsTextTag b) => O.MethodInfo TextBufferApplyTagMethodInfo a signature where
    overloadedMethod = textBufferApplyTag

#endif

-- method TextBuffer::apply_tag_by_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of a named #GtkTextTag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "one bound of range to be tagged"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "other bound of range to be tagged"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_apply_tag_by_name" gtk_text_buffer_apply_tag_by_name :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Gtk.TextIter.TextIter ->            -- start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO ()

-- | Calls 'GI.Gtk.Objects.TextTagTable.textTagTableLookup' on the buffer’s tag table to
-- get a t'GI.Gtk.Objects.TextTag.TextTag', then calls 'GI.Gtk.Objects.TextBuffer.textBufferApplyTag'.
textBufferApplyTagByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> T.Text
    -- ^ /@name@/: name of a named t'GI.Gtk.Objects.TextTag.TextTag'
    -> Gtk.TextIter.TextIter
    -- ^ /@start@/: one bound of range to be tagged
    -> Gtk.TextIter.TextIter
    -- ^ /@end@/: other bound of range to be tagged
    -> m ()
textBufferApplyTagByName :: a -> Text -> TextIter -> TextIter -> m ()
textBufferApplyTagByName a
buffer Text
name TextIter
start TextIter
end = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr TextIter
start' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
start
    Ptr TextIter
end' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
end
    Ptr TextBuffer -> CString -> Ptr TextIter -> Ptr TextIter -> IO ()
gtk_text_buffer_apply_tag_by_name Ptr TextBuffer
buffer' CString
name' Ptr TextIter
start' Ptr TextIter
end'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
start
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
end
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferApplyTagByNameMethodInfo
instance (signature ~ (T.Text -> Gtk.TextIter.TextIter -> Gtk.TextIter.TextIter -> m ()), MonadIO m, IsTextBuffer a) => O.MethodInfo TextBufferApplyTagByNameMethodInfo a signature where
    overloadedMethod = textBufferApplyTagByName

#endif

-- method TextBuffer::backspace
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a position in @buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interactive"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether the deletion is caused by user interaction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_editable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the buffer is editable by default"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_backspace" gtk_text_buffer_backspace :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gtk.TextIter.TextIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    CInt ->                                 -- interactive : TBasicType TBoolean
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO CInt

-- | Performs the appropriate action as if the user hit the delete
-- key with the cursor at the position specified by /@iter@/. In the
-- normal case a single character will be deleted, but when
-- combining accents are involved, more than one character can
-- be deleted, and when precomposed character and accent combinations
-- are involved, less than one character will be deleted.
-- 
-- Because the buffer is modified, all outstanding iterators become
-- invalid after calling this function; however, the /@iter@/ will be
-- re-initialized to point to the location where text was deleted.
-- 
-- /Since: 2.6/
textBufferBackspace ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: a position in /@buffer@/
    -> Bool
    -- ^ /@interactive@/: whether the deletion is caused by user interaction
    -> Bool
    -- ^ /@defaultEditable@/: whether the buffer is editable by default
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the buffer was modified
textBufferBackspace :: a -> TextIter -> Bool -> Bool -> m Bool
textBufferBackspace a
buffer TextIter
iter Bool
interactive Bool
defaultEditable = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    let interactive' :: CInt
interactive' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
interactive
    let defaultEditable' :: CInt
defaultEditable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
defaultEditable
    CInt
result <- Ptr TextBuffer -> Ptr TextIter -> CInt -> CInt -> IO CInt
gtk_text_buffer_backspace Ptr TextBuffer
buffer' Ptr TextIter
iter' CInt
interactive' CInt
defaultEditable'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextBufferBackspaceMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Bool -> Bool -> m Bool), MonadIO m, IsTextBuffer a) => O.MethodInfo TextBufferBackspaceMethodInfo a signature where
    overloadedMethod = textBufferBackspace

#endif

-- method TextBuffer::begin_user_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_begin_user_action" gtk_text_buffer_begin_user_action :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    IO ()

-- | Called to indicate that the buffer operations between here and a
-- call to 'GI.Gtk.Objects.TextBuffer.textBufferEndUserAction' are part of a single
-- user-visible operation. The operations between
-- 'GI.Gtk.Objects.TextBuffer.textBufferBeginUserAction' and
-- 'GI.Gtk.Objects.TextBuffer.textBufferEndUserAction' can then be grouped when creating
-- an undo stack. t'GI.Gtk.Objects.TextBuffer.TextBuffer' maintains a count of calls to
-- 'GI.Gtk.Objects.TextBuffer.textBufferBeginUserAction' that have not been closed with
-- a call to 'GI.Gtk.Objects.TextBuffer.textBufferEndUserAction', and emits the
-- “begin-user-action” and “end-user-action” signals only for the
-- outermost pair of calls. This allows you to build user actions
-- from other user actions.
-- 
-- The “interactive” buffer mutation functions, such as
-- 'GI.Gtk.Objects.TextBuffer.textBufferInsertInteractive', automatically call begin\/end
-- user action around the buffer operations they perform, so there\'s
-- no need to add extra calls if you user action consists solely of a
-- single call to one of those functions.
textBufferBeginUserAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> m ()
textBufferBeginUserAction :: a -> m ()
textBufferBeginUserAction a
buffer = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr TextBuffer -> IO ()
gtk_text_buffer_begin_user_action Ptr TextBuffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferBeginUserActionMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTextBuffer a) => O.MethodInfo TextBufferBeginUserActionMethodInfo a signature where
    overloadedMethod = textBufferBeginUserAction

#endif

-- method TextBuffer::copy_clipboard
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkClipboard object to copy to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_copy_clipboard" gtk_text_buffer_copy_clipboard :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gtk.Clipboard.Clipboard ->          -- clipboard : TInterface (Name {namespace = "Gtk", name = "Clipboard"})
    IO ()

-- | Copies the currently-selected text to a clipboard.
textBufferCopyClipboard ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a, Gtk.Clipboard.IsClipboard b) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> b
    -- ^ /@clipboard@/: the t'GI.Gtk.Objects.Clipboard.Clipboard' object to copy to
    -> m ()
textBufferCopyClipboard :: a -> b -> m ()
textBufferCopyClipboard a
buffer b
clipboard = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr Clipboard
clipboard' <- b -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
clipboard
    Ptr TextBuffer -> Ptr Clipboard -> IO ()
gtk_text_buffer_copy_clipboard Ptr TextBuffer
buffer' Ptr Clipboard
clipboard'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
clipboard
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferCopyClipboardMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTextBuffer a, Gtk.Clipboard.IsClipboard b) => O.MethodInfo TextBufferCopyClipboardMethodInfo a signature where
    overloadedMethod = textBufferCopyClipboard

#endif

-- method TextBuffer::create_child_anchor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location in the buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "TextChildAnchor" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_create_child_anchor" gtk_text_buffer_create_child_anchor :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gtk.TextIter.TextIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO (Ptr Gtk.TextChildAnchor.TextChildAnchor)

-- | This is a convenience function which simply creates a child anchor
-- with 'GI.Gtk.Objects.TextChildAnchor.textChildAnchorNew' and inserts it into the buffer
-- with 'GI.Gtk.Objects.TextBuffer.textBufferInsertChildAnchor'. The new anchor is
-- owned by the buffer; no reference count is returned to
-- the caller of 'GI.Gtk.Objects.TextBuffer.textBufferCreateChildAnchor'.
textBufferCreateChildAnchor ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: location in the buffer
    -> m Gtk.TextChildAnchor.TextChildAnchor
    -- ^ __Returns:__ the created child anchor
textBufferCreateChildAnchor :: a -> TextIter -> m TextChildAnchor
textBufferCreateChildAnchor a
buffer TextIter
iter = IO TextChildAnchor -> m TextChildAnchor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextChildAnchor -> m TextChildAnchor)
-> IO TextChildAnchor -> m TextChildAnchor
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    Ptr TextChildAnchor
result <- Ptr TextBuffer -> Ptr TextIter -> IO (Ptr TextChildAnchor)
gtk_text_buffer_create_child_anchor Ptr TextBuffer
buffer' Ptr TextIter
iter'
    Text -> Ptr TextChildAnchor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textBufferCreateChildAnchor" Ptr TextChildAnchor
result
    TextChildAnchor
result' <- ((ManagedPtr TextChildAnchor -> TextChildAnchor)
-> Ptr TextChildAnchor -> IO TextChildAnchor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TextChildAnchor -> TextChildAnchor
Gtk.TextChildAnchor.TextChildAnchor) Ptr TextChildAnchor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
    TextChildAnchor -> IO TextChildAnchor
forall (m :: * -> *) a. Monad m => a -> m a
return TextChildAnchor
result'

#if defined(ENABLE_OVERLOADING)
data TextBufferCreateChildAnchorMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> m Gtk.TextChildAnchor.TextChildAnchor), MonadIO m, IsTextBuffer a) => O.MethodInfo TextBufferCreateChildAnchorMethodInfo a signature where
    overloadedMethod = textBufferCreateChildAnchor

#endif

-- method TextBuffer::create_mark
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mark_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name for mark, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "where"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to place mark"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "left_gravity"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the mark has left gravity"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "TextMark" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_create_mark" gtk_text_buffer_create_mark :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    CString ->                              -- mark_name : TBasicType TUTF8
    Ptr Gtk.TextIter.TextIter ->            -- where : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    CInt ->                                 -- left_gravity : TBasicType TBoolean
    IO (Ptr Gtk.TextMark.TextMark)

-- | Creates a mark at position /@where@/. If /@markName@/ is 'P.Nothing', the mark
-- is anonymous; otherwise, the mark can be retrieved by name using
-- 'GI.Gtk.Objects.TextBuffer.textBufferGetMark'. If a mark has left gravity, and text is
-- inserted at the mark’s current location, the mark will be moved to
-- the left of the newly-inserted text. If the mark has right gravity
-- (/@leftGravity@/ = 'P.False'), the mark will end up on the right of
-- newly-inserted text. The standard left-to-right cursor is a mark
-- with right gravity (when you type, the cursor stays on the right
-- side of the text you’re typing).
-- 
-- The caller of this function does not own a
-- reference to the returned t'GI.Gtk.Objects.TextMark.TextMark', so you can ignore the
-- return value if you like. Marks are owned by the buffer and go
-- away when the buffer does.
-- 
-- Emits the [markSet]("GI.Gtk.Objects.TextBuffer#g:signal:markSet") signal as notification of the mark\'s
-- initial placement.
textBufferCreateMark ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> Maybe (T.Text)
    -- ^ /@markName@/: name for mark, or 'P.Nothing'
    -> Gtk.TextIter.TextIter
    -- ^ /@where@/: location to place mark
    -> Bool
    -- ^ /@leftGravity@/: whether the mark has left gravity
    -> m Gtk.TextMark.TextMark
    -- ^ __Returns:__ the new t'GI.Gtk.Objects.TextMark.TextMark' object
textBufferCreateMark :: a -> Maybe Text -> TextIter -> Bool -> m TextMark
textBufferCreateMark a
buffer Maybe Text
markName TextIter
where_ Bool
leftGravity = IO TextMark -> m TextMark
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextMark -> m TextMark) -> IO TextMark -> m TextMark
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    CString
maybeMarkName <- case Maybe Text
markName of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jMarkName -> do
            CString
jMarkName' <- Text -> IO CString
textToCString Text
jMarkName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jMarkName'
    Ptr TextIter
where_' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
where_
    let leftGravity' :: CInt
leftGravity' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
leftGravity
    Ptr TextMark
result <- Ptr TextBuffer
-> CString -> Ptr TextIter -> CInt -> IO (Ptr TextMark)
gtk_text_buffer_create_mark Ptr TextBuffer
buffer' CString
maybeMarkName Ptr TextIter
where_' CInt
leftGravity'
    Text -> Ptr TextMark -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textBufferCreateMark" Ptr TextMark
result
    TextMark
result' <- ((ManagedPtr TextMark -> TextMark) -> Ptr TextMark -> IO TextMark
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TextMark -> TextMark
Gtk.TextMark.TextMark) Ptr TextMark
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
where_
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeMarkName
    TextMark -> IO TextMark
forall (m :: * -> *) a. Monad m => a -> m a
return TextMark
result'

#if defined(ENABLE_OVERLOADING)
data TextBufferCreateMarkMethodInfo
instance (signature ~ (Maybe (T.Text) -> Gtk.TextIter.TextIter -> Bool -> m Gtk.TextMark.TextMark), MonadIO m, IsTextBuffer a) => O.MethodInfo TextBufferCreateMarkMethodInfo a signature where
    overloadedMethod = textBufferCreateMark

#endif

-- method TextBuffer::cut_clipboard
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkClipboard object to cut to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_editable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "default editability of the buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_cut_clipboard" gtk_text_buffer_cut_clipboard :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gtk.Clipboard.Clipboard ->          -- clipboard : TInterface (Name {namespace = "Gtk", name = "Clipboard"})
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO ()

-- | Copies the currently-selected text to a clipboard, then deletes
-- said text if it’s editable.
textBufferCutClipboard ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a, Gtk.Clipboard.IsClipboard b) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> b
    -- ^ /@clipboard@/: the t'GI.Gtk.Objects.Clipboard.Clipboard' object to cut to
    -> Bool
    -- ^ /@defaultEditable@/: default editability of the buffer
    -> m ()
textBufferCutClipboard :: a -> b -> Bool -> m ()
textBufferCutClipboard a
buffer b
clipboard Bool
defaultEditable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr Clipboard
clipboard' <- b -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
clipboard
    let defaultEditable' :: CInt
defaultEditable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
defaultEditable
    Ptr TextBuffer -> Ptr Clipboard -> CInt -> IO ()
gtk_text_buffer_cut_clipboard Ptr TextBuffer
buffer' Ptr Clipboard
clipboard' CInt
defaultEditable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
clipboard
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferCutClipboardMethodInfo
instance (signature ~ (b -> Bool -> m ()), MonadIO m, IsTextBuffer a, Gtk.Clipboard.IsClipboard b) => O.MethodInfo TextBufferCutClipboardMethodInfo a signature where
    overloadedMethod = textBufferCutClipboard

#endif

-- method TextBuffer::delete
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a position in @buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another position in @buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_delete" gtk_text_buffer_delete :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gtk.TextIter.TextIter ->            -- start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO ()

-- | Deletes text between /@start@/ and /@end@/. The order of /@start@/ and /@end@/
-- is not actually relevant; 'GI.Gtk.Objects.TextBuffer.textBufferDelete' will reorder
-- them. This function actually emits the “delete-range” signal, and
-- the default handler of that signal deletes the text. Because the
-- buffer is modified, all outstanding iterators become invalid after
-- calling this function; however, the /@start@/ and /@end@/ will be
-- re-initialized to point to the location where text was deleted.
textBufferDelete ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> Gtk.TextIter.TextIter
    -- ^ /@start@/: a position in /@buffer@/
    -> Gtk.TextIter.TextIter
    -- ^ /@end@/: another position in /@buffer@/
    -> m ()
textBufferDelete :: a -> TextIter -> TextIter -> m ()
textBufferDelete a
buffer TextIter
start TextIter
end = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr TextIter
start' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
start
    Ptr TextIter
end' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
end
    Ptr TextBuffer -> Ptr TextIter -> Ptr TextIter -> IO ()
gtk_text_buffer_delete Ptr TextBuffer
buffer' Ptr TextIter
start' Ptr TextIter
end'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
start
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
end
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferDeleteMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Gtk.TextIter.TextIter -> m ()), MonadIO m, IsTextBuffer a) => O.MethodInfo TextBufferDeleteMethodInfo a signature where
    overloadedMethod = textBufferDelete

#endif

-- method TextBuffer::delete_interactive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of range to delete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end_iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "end of range" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_editable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the buffer is editable by default"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_delete_interactive" gtk_text_buffer_delete_interactive :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gtk.TextIter.TextIter ->            -- start_iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- end_iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO CInt

-- | Deletes all editable text in the given range.
-- Calls 'GI.Gtk.Objects.TextBuffer.textBufferDelete' for each editable sub-range of
-- [/@start@/,/@end@/). /@start@/ and /@end@/ are revalidated to point to
-- the location of the last deleted range, or left untouched if
-- no text was deleted.
textBufferDeleteInteractive ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> Gtk.TextIter.TextIter
    -- ^ /@startIter@/: start of range to delete
    -> Gtk.TextIter.TextIter
    -- ^ /@endIter@/: end of range
    -> Bool
    -- ^ /@defaultEditable@/: whether the buffer is editable by default
    -> m Bool
    -- ^ __Returns:__ whether some text was actually deleted
textBufferDeleteInteractive :: a -> TextIter -> TextIter -> Bool -> m Bool
textBufferDeleteInteractive a
buffer TextIter
startIter TextIter
endIter Bool
defaultEditable = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr TextIter
startIter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
startIter
    Ptr TextIter
endIter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
endIter
    let defaultEditable' :: CInt
defaultEditable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
defaultEditable
    CInt
result <- Ptr TextBuffer -> Ptr TextIter -> Ptr TextIter -> CInt -> IO CInt
gtk_text_buffer_delete_interactive Ptr TextBuffer
buffer' Ptr TextIter
startIter' Ptr TextIter
endIter' CInt
defaultEditable'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
startIter
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
endIter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextBufferDeleteInteractiveMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Gtk.TextIter.TextIter -> Bool -> m Bool), MonadIO m, IsTextBuffer a) => O.MethodInfo TextBufferDeleteInteractiveMethodInfo a signature where
    overloadedMethod = textBufferDeleteInteractive

#endif

-- method TextBuffer::delete_mark
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mark"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextMark" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextMark in @buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_delete_mark" gtk_text_buffer_delete_mark :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gtk.TextMark.TextMark ->            -- mark : TInterface (Name {namespace = "Gtk", name = "TextMark"})
    IO ()

-- | Deletes /@mark@/, so that it’s no longer located anywhere in the
-- buffer. Removes the reference the buffer holds to the mark, so if
-- you haven’t called 'GI.GObject.Objects.Object.objectRef' on the mark, it will be freed. Even
-- if the mark isn’t freed, most operations on /@mark@/ become
-- invalid, until it gets added to a buffer again with
-- 'GI.Gtk.Objects.TextBuffer.textBufferAddMark'. Use 'GI.Gtk.Objects.TextMark.textMarkGetDeleted' to
-- find out if a mark has been removed from its buffer.
-- The [markDeleted]("GI.Gtk.Objects.TextBuffer#g:signal:markDeleted") signal will be emitted as notification after
-- the mark is deleted.
textBufferDeleteMark ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a, Gtk.TextMark.IsTextMark b) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> b
    -- ^ /@mark@/: a t'GI.Gtk.Objects.TextMark.TextMark' in /@buffer@/
    -> m ()
textBufferDeleteMark :: a -> b -> m ()
textBufferDeleteMark a
buffer b
mark = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr TextMark
mark' <- b -> IO (Ptr TextMark)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
mark
    Ptr TextBuffer -> Ptr TextMark -> IO ()
gtk_text_buffer_delete_mark Ptr TextBuffer
buffer' Ptr TextMark
mark'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
mark
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferDeleteMarkMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTextBuffer a, Gtk.TextMark.IsTextMark b) => O.MethodInfo TextBufferDeleteMarkMethodInfo a signature where
    overloadedMethod = textBufferDeleteMark

#endif

-- method TextBuffer::delete_mark_by_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of a mark in @buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_delete_mark_by_name" gtk_text_buffer_delete_mark_by_name :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Deletes the mark named /@name@/; the mark must exist. See
-- 'GI.Gtk.Objects.TextBuffer.textBufferDeleteMark' for details.
textBufferDeleteMarkByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> T.Text
    -- ^ /@name@/: name of a mark in /@buffer@/
    -> m ()
textBufferDeleteMarkByName :: a -> Text -> m ()
textBufferDeleteMarkByName a
buffer Text
name = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr TextBuffer -> CString -> IO ()
gtk_text_buffer_delete_mark_by_name Ptr TextBuffer
buffer' CString
name'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferDeleteMarkByNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsTextBuffer a) => O.MethodInfo TextBufferDeleteMarkByNameMethodInfo a signature where
    overloadedMethod = textBufferDeleteMarkByName

#endif

-- method TextBuffer::delete_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interactive"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether the deletion is caused by user interaction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_editable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the buffer is editable by default"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_buffer_delete_selection" gtk_text_buffer_delete_selection :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    CInt ->                                 -- interactive : TBasicType TBoolean
    CInt ->                                 -- default_editable : TBasicType TBoolean
    IO CInt

-- | Deletes the range between the “insert” and “selection_bound” marks,
-- that is, the currently-selected text. If /@interactive@/ is 'P.True',
-- the editability of the selection will be considered (users can’t delete
-- uneditable text).
textBufferDeleteSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> Bool
    -- ^ /@interactive@/: whether the deletion is caused by user interaction
    -> Bool
    -- ^ /@defaultEditable@/: whether the buffer is editable by default
    -> m Bool
    -- ^ __Returns:__ whether there was a non-empty selection to delete
textBufferDeleteSelection :: a -> Bool -> Bool -> m Bool
textBufferDeleteSelection a
buffer Bool
interactive Bool
defaultEditable = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    let interactive' :: CInt
interactive' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
interactive
    let defaultEditable' :: CInt
defaultEditable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
defaultEditable
    CInt
result <- Ptr TextBuffer -> CInt -> CInt -> IO CInt
gtk_text_buffer_delete_selection Ptr TextBuffer
buffer' CInt
interactive' CInt
defaultEditable'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextBufferDeleteSelectionMethodInfo
instance (signature ~ (Bool -> Bool -> m Bool), MonadIO m, IsTextBuffer a) => O.MethodInfo TextBufferDeleteSelectionMethodInfo a signature where
    overloadedMethod = textBufferDeleteSelection

#endif

-- method TextBuffer::deserialize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "register_buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkTextBuffer @format is registered with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkTextBuffer to deserialize into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Atom" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rich text format to use for deserializing"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "insertion point for the deserialized text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 5 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to deserialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of @data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of @data" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

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

-- | This function deserializes rich text in format /@format@/ and inserts
-- it at /@iter@/.
-- 
-- /@formats@/ to be used must be registered using
-- 'GI.Gtk.Objects.TextBuffer.textBufferRegisterDeserializeFormat' or
-- 'GI.Gtk.Objects.TextBuffer.textBufferRegisterDeserializeTagset' beforehand.
-- 
-- /Since: 2.10/
textBufferDeserialize ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a, IsTextBuffer b) =>
    a
    -- ^ /@registerBuffer@/: the t'GI.Gtk.Objects.TextBuffer.TextBuffer' /@format@/ is registered with
    -> b
    -- ^ /@contentBuffer@/: the t'GI.Gtk.Objects.TextBuffer.TextBuffer' to deserialize into
    -> Gdk.Atom.Atom
    -- ^ /@format@/: the rich text format to use for deserializing
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: insertion point for the deserialized text
    -> ByteString
    -- ^ /@data@/: data to deserialize
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
textBufferDeserialize :: a -> b -> Atom -> TextIter -> ByteString -> m ()
textBufferDeserialize a
registerBuffer b
contentBuffer Atom
format TextIter
iter ByteString
data_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let length_ :: Word64
length_ = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr TextBuffer
registerBuffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
registerBuffer
    Ptr TextBuffer
contentBuffer' <- b -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
contentBuffer
    Ptr Atom
format' <- Atom -> IO (Ptr Atom)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Atom
format
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr TextBuffer
-> Ptr TextBuffer
-> Ptr Atom
-> Ptr TextIter
-> Ptr Word8
-> Word64
-> Ptr (Ptr GError)
-> IO CInt
gtk_text_buffer_deserialize Ptr TextBuffer
registerBuffer' Ptr TextBuffer
contentBuffer' Ptr Atom
format' Ptr TextIter
iter' Ptr Word8
data_' Word64
length_
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registerBuffer
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
contentBuffer
        Atom -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Atom
format
        TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
     )

#if defined(ENABLE_OVERLOADING)
data TextBufferDeserializeMethodInfo
instance (signature ~ (b -> Gdk.Atom.Atom -> Gtk.TextIter.TextIter -> ByteString -> m ()), MonadIO m, IsTextBuffer a, IsTextBuffer b) => O.MethodInfo TextBufferDeserializeMethodInfo a signature where
    overloadedMethod = textBufferDeserialize

#endif

-- method TextBuffer::deserialize_get_can_create_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Atom" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GdkAtom representing a registered rich text format"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (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 ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gdk.Atom.Atom ->                    -- format : TInterface (Name {namespace = "Gdk", name = "Atom"})
    IO CInt

-- | This functions returns the value set with
-- 'GI.Gtk.Objects.TextBuffer.textBufferDeserializeSetCanCreateTags'
-- 
-- /Since: 2.10/
textBufferDeserializeGetCanCreateTags ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> Gdk.Atom.Atom
    -- ^ /@format@/: a t'GI.Gdk.Structs.Atom.Atom' representing a registered rich text format
    -> m Bool
    -- ^ __Returns:__ whether deserializing this format may create tags
textBufferDeserializeGetCanCreateTags :: a -> Atom -> m Bool
textBufferDeserializeGetCanCreateTags a
buffer Atom
format = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr Atom
format' <- Atom -> IO (Ptr Atom)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Atom
format
    CInt
result <- Ptr TextBuffer -> Ptr Atom -> IO CInt
gtk_text_buffer_deserialize_get_can_create_tags Ptr TextBuffer
buffer' Ptr Atom
format'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Atom -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Atom
format
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextBufferDeserializeGetCanCreateTagsMethodInfo
instance (signature ~ (Gdk.Atom.Atom -> m Bool), MonadIO m, IsTextBuffer a) => O.MethodInfo TextBufferDeserializeGetCanCreateTagsMethodInfo a signature where
    overloadedMethod = textBufferDeserializeGetCanCreateTags

#endif

-- method TextBuffer::deserialize_set_can_create_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Atom" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GdkAtom representing a registered rich text format"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "can_create_tags"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether deserializing this format may create tags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- 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 ->                       -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    Ptr Gdk.Atom.Atom ->                    -- format : TInterface (Name {namespace = "Gdk", name = "Atom"})
    CInt ->                                 -- can_create_tags : TBasicType TBoolean
    IO ()

-- | Use this function to allow a rich text deserialization function to
-- create new tags in the receiving buffer. Note that using this
-- function is almost always a bad idea, because the rich text
-- functions you register should know how to map the rich text format
-- they handler to your text buffers set of tags.
-- 
-- The ability of creating new (arbitrary!) tags in the receiving buffer
-- is meant for special rich text formats like the internal one that
-- is registered using 'GI.Gtk.Objects.TextBuffer.textBufferRegisterDeserializeTagset',
-- because that format is essentially a dump of the internal structure
-- of the source buffer, including its tag names.
-- 
-- You should allow creation of tags only if you know what you are
-- doing, e.g. if you defined a tagset name for your application
-- suite’s text buffers and you know that it’s fine to receive new
-- tags from these buffers, because you know that your application can
-- handle the newly created tags.
-- 
-- /Since: 2.10/
textBufferDeserializeSetCanCreateTags ::