{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Objects.TextBuffer.TextBuffer' structure contains private
-- data and it should only be accessed using the provided API.
-- 
-- /Since: 1.10/

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

module GI.Clutter.Objects.TextBuffer
    ( 

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


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [deleteText]("GI.Clutter.Objects.TextBuffer#g:method:deleteText"), [emitDeletedText]("GI.Clutter.Objects.TextBuffer#g:method:emitDeletedText"), [emitInsertedText]("GI.Clutter.Objects.TextBuffer#g:method:emitInsertedText"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [insertText]("GI.Clutter.Objects.TextBuffer#g:method:insertText"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getBytes]("GI.Clutter.Objects.TextBuffer#g:method:getBytes"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getLength]("GI.Clutter.Objects.TextBuffer#g:method:getLength"), [getMaxLength]("GI.Clutter.Objects.TextBuffer#g:method:getMaxLength"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getText]("GI.Clutter.Objects.TextBuffer#g:method:getText").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setMaxLength]("GI.Clutter.Objects.TextBuffer#g:method:setMaxLength"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setText]("GI.Clutter.Objects.TextBuffer#g:method:setText").

#if defined(ENABLE_OVERLOADING)
    ResolveTextBufferMethod                 ,
#endif

-- ** deleteText #method:deleteText#

#if defined(ENABLE_OVERLOADING)
    TextBufferDeleteTextMethodInfo          ,
#endif
    textBufferDeleteText                    ,


-- ** emitDeletedText #method:emitDeletedText#

#if defined(ENABLE_OVERLOADING)
    TextBufferEmitDeletedTextMethodInfo     ,
#endif
    textBufferEmitDeletedText               ,


-- ** emitInsertedText #method:emitInsertedText#

#if defined(ENABLE_OVERLOADING)
    TextBufferEmitInsertedTextMethodInfo    ,
#endif
    textBufferEmitInsertedText              ,


-- ** getBytes #method:getBytes#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetBytesMethodInfo            ,
#endif
    textBufferGetBytes                      ,


-- ** getLength #method:getLength#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetLengthMethodInfo           ,
#endif
    textBufferGetLength                     ,


-- ** getMaxLength #method:getMaxLength#

#if defined(ENABLE_OVERLOADING)
    TextBufferGetMaxLengthMethodInfo        ,
#endif
    textBufferGetMaxLength                  ,


-- ** getText #method:getText#

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


-- ** insertText #method:insertText#

#if defined(ENABLE_OVERLOADING)
    TextBufferInsertTextMethodInfo          ,
#endif
    textBufferInsertText                    ,


-- ** new #method:new#

    textBufferNew                           ,


-- ** newWithText #method:newWithText#

    textBufferNewWithText                   ,


-- ** setMaxLength #method:setMaxLength#

#if defined(ENABLE_OVERLOADING)
    TextBufferSetMaxLengthMethodInfo        ,
#endif
    textBufferSetMaxLength                  ,


-- ** setText #method:setText#

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




 -- * Properties


-- ** length #attr:length#
-- | The length (in characters) of the text in buffer.
-- 
-- /Since: 1.10/

#if defined(ENABLE_OVERLOADING)
    TextBufferLengthPropertyInfo            ,
#endif
    getTextBufferLength                     ,
#if defined(ENABLE_OVERLOADING)
    textBufferLength                        ,
#endif


-- ** maxLength #attr:maxLength#
-- | The maximum length (in characters) of the text in the buffer.
-- 
-- /Since: 1.10/

#if defined(ENABLE_OVERLOADING)
    TextBufferMaxLengthPropertyInfo         ,
#endif
    constructTextBufferMaxLength            ,
    getTextBufferMaxLength                  ,
    setTextBufferMaxLength                  ,
#if defined(ENABLE_OVERLOADING)
    textBufferMaxLength                     ,
#endif


-- ** text #attr:text#
-- | The contents of the buffer.
-- 
-- /Since: 1.10/

#if defined(ENABLE_OVERLOADING)
    TextBufferTextPropertyInfo              ,
#endif
    getTextBufferText                       ,
#if defined(ENABLE_OVERLOADING)
    textBufferText                          ,
#endif




 -- * Signals


-- ** deletedText #signal:deletedText#

    TextBufferDeletedTextCallback           ,
#if defined(ENABLE_OVERLOADING)
    TextBufferDeletedTextSignalInfo         ,
#endif
    afterTextBufferDeletedText              ,
    onTextBufferDeletedText                 ,


-- ** insertedText #signal:insertedText#

    TextBufferInsertedTextCallback          ,
#if defined(ENABLE_OVERLOADING)
    TextBufferInsertedTextSignalInfo        ,
#endif
    afterTextBufferInsertedText             ,
    onTextBufferInsertedText                ,




    ) 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.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object

-- | 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
$c== :: TextBuffer -> TextBuffer -> Bool
== :: TextBuffer -> TextBuffer -> Bool
$c/= :: TextBuffer -> TextBuffer -> Bool
/= :: TextBuffer -> TextBuffer -> Bool
Eq)

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

foreign import ccall "clutter_text_buffer_get_type"
    c_clutter_text_buffer_get_type :: IO B.Types.GType

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

instance B.Types.GObject TextBuffer

-- | 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 :: (MIO.MonadIO m, IsTextBuffer o) => o -> m TextBuffer
toTextBuffer :: forall (m :: * -> *) o.
(MonadIO m, IsTextBuffer o) =>
o -> m TextBuffer
toTextBuffer = IO TextBuffer -> m TextBuffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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'
B.ManagedPtr.unsafeCastTo ManagedPtr TextBuffer -> TextBuffer
TextBuffer

-- | Convert 'TextBuffer' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe TextBuffer) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_text_buffer_get_type
    gvalueSet_ :: Ptr GValue -> Maybe TextBuffer -> IO ()
gvalueSet_ Ptr GValue
gv Maybe TextBuffer
P.Nothing = Ptr GValue -> Ptr TextBuffer -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr TextBuffer
forall a. Ptr a
FP.nullPtr :: FP.Ptr TextBuffer)
    gvalueSet_ Ptr GValue
gv (P.Just TextBuffer
obj) = TextBuffer -> (Ptr TextBuffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TextBuffer
obj (Ptr GValue -> Ptr TextBuffer -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe TextBuffer)
gvalueGet_ Ptr GValue
gv = do
        Ptr TextBuffer
ptr <- Ptr GValue -> IO (Ptr TextBuffer)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr TextBuffer)
        if Ptr TextBuffer
ptr Ptr TextBuffer -> Ptr TextBuffer -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr TextBuffer
forall a. Ptr a
FP.nullPtr
        then TextBuffer -> Maybe TextBuffer
forall a. a -> Maybe a
P.Just (TextBuffer -> Maybe TextBuffer)
-> IO TextBuffer -> IO (Maybe TextBuffer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
        else Maybe TextBuffer -> IO (Maybe TextBuffer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TextBuffer
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveTextBufferMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTextBufferMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTextBufferMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTextBufferMethod "deleteText" o = TextBufferDeleteTextMethodInfo
    ResolveTextBufferMethod "emitDeletedText" o = TextBufferEmitDeletedTextMethodInfo
    ResolveTextBufferMethod "emitInsertedText" o = TextBufferEmitInsertedTextMethodInfo
    ResolveTextBufferMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTextBufferMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTextBufferMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTextBufferMethod "insertText" o = TextBufferInsertTextMethodInfo
    ResolveTextBufferMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTextBufferMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTextBufferMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTextBufferMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTextBufferMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTextBufferMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    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 "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTextBufferMethod "getBytes" o = TextBufferGetBytesMethodInfo
    ResolveTextBufferMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTextBufferMethod "getLength" o = TextBufferGetLengthMethodInfo
    ResolveTextBufferMethod "getMaxLength" o = TextBufferGetMaxLengthMethodInfo
    ResolveTextBufferMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTextBufferMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTextBufferMethod "getText" o = TextBufferGetTextMethodInfo
    ResolveTextBufferMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTextBufferMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTextBufferMethod "setMaxLength" o = TextBufferSetMaxLengthMethodInfo
    ResolveTextBufferMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTextBufferMethod "setText" o = TextBufferSetTextMethodInfo
    ResolveTextBufferMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveTextBufferMethod t TextBuffer, O.OverloadedMethod 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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveTextBufferMethod t TextBuffer, O.OverloadedMethod info TextBuffer p, R.HasField t TextBuffer p) => R.HasField t TextBuffer p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveTextBufferMethod t TextBuffer, O.OverloadedMethodInfo info TextBuffer) => OL.IsLabel t (O.MethodProxy info TextBuffer) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal TextBuffer::deleted-text
-- | This signal is emitted after text is deleted from the buffer.
-- 
-- /Since: 1.10/
type TextBufferDeletedTextCallback =
    Word32
    -- ^ /@position@/: the position the text was deleted at.
    -> Word32
    -- ^ /@nChars@/: The number of characters that were deleted.
    -> IO ()

type C_TextBufferDeletedTextCallback =
    Ptr TextBuffer ->                       -- object
    Word32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TextBufferDeletedTextCallback :: 
    GObject a => (a -> TextBufferDeletedTextCallback) ->
    C_TextBufferDeletedTextCallback
wrap_TextBufferDeletedTextCallback :: forall a.
GObject a =>
(a -> TextBufferDeletedTextCallback)
-> C_TextBufferDeletedTextCallback
wrap_TextBufferDeletedTextCallback a -> TextBufferDeletedTextCallback
gi'cb Ptr TextBuffer
gi'selfPtr Word32
position Word32
nChars Ptr ()
_ = do
    Ptr TextBuffer -> (TextBuffer -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr TextBuffer
gi'selfPtr ((TextBuffer -> IO ()) -> IO ()) -> (TextBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextBuffer
gi'self -> a -> TextBufferDeletedTextCallback
gi'cb (TextBuffer -> a
forall a b. Coercible a b => a -> b
Coerce.coerce TextBuffer
gi'self)  Word32
position Word32
nChars


-- | Connect a signal handler for the [deletedText](#signal:deletedText) 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 #deletedText callback
-- @
-- 
-- 
onTextBufferDeletedText :: (IsTextBuffer a, MonadIO m) => a -> ((?self :: a) => TextBufferDeletedTextCallback) -> m SignalHandlerId
onTextBufferDeletedText :: forall a (m :: * -> *).
(IsTextBuffer a, MonadIO m) =>
a
-> ((?self::a) => TextBufferDeletedTextCallback)
-> m SignalHandlerId
onTextBufferDeletedText a
obj (?self::a) => TextBufferDeletedTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> TextBufferDeletedTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextBufferDeletedTextCallback
TextBufferDeletedTextCallback
cb
    let wrapped' :: C_TextBufferDeletedTextCallback
wrapped' = (a -> TextBufferDeletedTextCallback)
-> C_TextBufferDeletedTextCallback
forall a.
GObject a =>
(a -> TextBufferDeletedTextCallback)
-> C_TextBufferDeletedTextCallback
wrap_TextBufferDeletedTextCallback a -> TextBufferDeletedTextCallback
wrapped
    FunPtr C_TextBufferDeletedTextCallback
wrapped'' <- C_TextBufferDeletedTextCallback
-> IO (FunPtr C_TextBufferDeletedTextCallback)
mk_TextBufferDeletedTextCallback C_TextBufferDeletedTextCallback
wrapped'
    a
-> Text
-> FunPtr C_TextBufferDeletedTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"deleted-text" FunPtr C_TextBufferDeletedTextCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deletedText](#signal:deletedText) 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 #deletedText callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextBufferDeletedText :: (IsTextBuffer a, MonadIO m) => a -> ((?self :: a) => TextBufferDeletedTextCallback) -> m SignalHandlerId
afterTextBufferDeletedText :: forall a (m :: * -> *).
(IsTextBuffer a, MonadIO m) =>
a
-> ((?self::a) => TextBufferDeletedTextCallback)
-> m SignalHandlerId
afterTextBufferDeletedText a
obj (?self::a) => TextBufferDeletedTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> TextBufferDeletedTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextBufferDeletedTextCallback
TextBufferDeletedTextCallback
cb
    let wrapped' :: C_TextBufferDeletedTextCallback
wrapped' = (a -> TextBufferDeletedTextCallback)
-> C_TextBufferDeletedTextCallback
forall a.
GObject a =>
(a -> TextBufferDeletedTextCallback)
-> C_TextBufferDeletedTextCallback
wrap_TextBufferDeletedTextCallback a -> TextBufferDeletedTextCallback
wrapped
    FunPtr C_TextBufferDeletedTextCallback
wrapped'' <- C_TextBufferDeletedTextCallback
-> IO (FunPtr C_TextBufferDeletedTextCallback)
mk_TextBufferDeletedTextCallback C_TextBufferDeletedTextCallback
wrapped'
    a
-> Text
-> FunPtr C_TextBufferDeletedTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"deleted-text" FunPtr C_TextBufferDeletedTextCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferDeletedTextSignalInfo
instance SignalInfo TextBufferDeletedTextSignalInfo where
    type HaskellCallbackType TextBufferDeletedTextSignalInfo = TextBufferDeletedTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferDeletedTextCallback cb
        cb'' <- mk_TextBufferDeletedTextCallback cb'
        connectSignalFunPtr obj "deleted-text" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer::deleted-text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#g:signal:deletedText"})

#endif

-- signal TextBuffer::inserted-text
-- | This signal is emitted after text is inserted into the buffer.
-- 
-- /Since: 1.10/
type TextBufferInsertedTextCallback =
    Word32
    -- ^ /@position@/: the position the text was inserted at.
    -> T.Text
    -- ^ /@chars@/: The text that was inserted.
    -> Word32
    -- ^ /@nChars@/: The number of characters that were inserted.
    -> IO ()

type C_TextBufferInsertedTextCallback =
    Ptr TextBuffer ->                       -- object
    Word32 ->
    CString ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TextBufferInsertedTextCallback :: 
    GObject a => (a -> TextBufferInsertedTextCallback) ->
    C_TextBufferInsertedTextCallback
wrap_TextBufferInsertedTextCallback :: forall a.
GObject a =>
(a -> TextBufferInsertedTextCallback)
-> C_TextBufferInsertedTextCallback
wrap_TextBufferInsertedTextCallback a -> TextBufferInsertedTextCallback
gi'cb Ptr TextBuffer
gi'selfPtr Word32
position CString
chars Word32
nChars Ptr ()
_ = do
    Text
chars' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
chars
    Ptr TextBuffer -> (TextBuffer -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr TextBuffer
gi'selfPtr ((TextBuffer -> IO ()) -> IO ()) -> (TextBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextBuffer
gi'self -> a -> TextBufferInsertedTextCallback
gi'cb (TextBuffer -> a
forall a b. Coercible a b => a -> b
Coerce.coerce TextBuffer
gi'self)  Word32
position Text
chars' Word32
nChars


-- | Connect a signal handler for the [insertedText](#signal:insertedText) 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 #insertedText callback
-- @
-- 
-- 
onTextBufferInsertedText :: (IsTextBuffer a, MonadIO m) => a -> ((?self :: a) => TextBufferInsertedTextCallback) -> m SignalHandlerId
onTextBufferInsertedText :: forall a (m :: * -> *).
(IsTextBuffer a, MonadIO m) =>
a
-> ((?self::a) => TextBufferInsertedTextCallback)
-> m SignalHandlerId
onTextBufferInsertedText a
obj (?self::a) => TextBufferInsertedTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> TextBufferInsertedTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextBufferInsertedTextCallback
TextBufferInsertedTextCallback
cb
    let wrapped' :: C_TextBufferInsertedTextCallback
wrapped' = (a -> TextBufferInsertedTextCallback)
-> C_TextBufferInsertedTextCallback
forall a.
GObject a =>
(a -> TextBufferInsertedTextCallback)
-> C_TextBufferInsertedTextCallback
wrap_TextBufferInsertedTextCallback a -> TextBufferInsertedTextCallback
wrapped
    FunPtr C_TextBufferInsertedTextCallback
wrapped'' <- C_TextBufferInsertedTextCallback
-> IO (FunPtr C_TextBufferInsertedTextCallback)
mk_TextBufferInsertedTextCallback C_TextBufferInsertedTextCallback
wrapped'
    a
-> Text
-> FunPtr C_TextBufferInsertedTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"inserted-text" FunPtr C_TextBufferInsertedTextCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [insertedText](#signal:insertedText) 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 #insertedText callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextBufferInsertedText :: (IsTextBuffer a, MonadIO m) => a -> ((?self :: a) => TextBufferInsertedTextCallback) -> m SignalHandlerId
afterTextBufferInsertedText :: forall a (m :: * -> *).
(IsTextBuffer a, MonadIO m) =>
a
-> ((?self::a) => TextBufferInsertedTextCallback)
-> m SignalHandlerId
afterTextBufferInsertedText a
obj (?self::a) => TextBufferInsertedTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> TextBufferInsertedTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextBufferInsertedTextCallback
TextBufferInsertedTextCallback
cb
    let wrapped' :: C_TextBufferInsertedTextCallback
wrapped' = (a -> TextBufferInsertedTextCallback)
-> C_TextBufferInsertedTextCallback
forall a.
GObject a =>
(a -> TextBufferInsertedTextCallback)
-> C_TextBufferInsertedTextCallback
wrap_TextBufferInsertedTextCallback a -> TextBufferInsertedTextCallback
wrapped
    FunPtr C_TextBufferInsertedTextCallback
wrapped'' <- C_TextBufferInsertedTextCallback
-> IO (FunPtr C_TextBufferInsertedTextCallback)
mk_TextBufferInsertedTextCallback C_TextBufferInsertedTextCallback
wrapped'
    a
-> Text
-> FunPtr C_TextBufferInsertedTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"inserted-text" FunPtr C_TextBufferInsertedTextCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBufferInsertedTextSignalInfo
instance SignalInfo TextBufferInsertedTextSignalInfo where
    type HaskellCallbackType TextBufferInsertedTextSignalInfo = TextBufferInsertedTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBufferInsertedTextCallback cb
        cb'' <- mk_TextBufferInsertedTextCallback cb'
        connectSignalFunPtr obj "inserted-text" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer::inserted-text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#g:signal:insertedText"})

#endif

-- VVV Prop "length"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data TextBufferLengthPropertyInfo
instance AttrInfo TextBufferLengthPropertyInfo where
    type AttrAllowedOps TextBufferLengthPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint TextBufferLengthPropertyInfo = IsTextBuffer
    type AttrSetTypeConstraint TextBufferLengthPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TextBufferLengthPropertyInfo = (~) ()
    type AttrTransferType TextBufferLengthPropertyInfo = ()
    type AttrGetType TextBufferLengthPropertyInfo = Word32
    type AttrLabel TextBufferLengthPropertyInfo = "length"
    type AttrOrigin TextBufferLengthPropertyInfo = TextBuffer
    attrGet = getTextBufferLength
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.length"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#g:attr:length"
        })
#endif

-- VVV Prop "max-length"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@max-length@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textBuffer #maxLength
-- @
getTextBufferMaxLength :: (MonadIO m, IsTextBuffer o) => o -> m Int32
getTextBufferMaxLength :: forall (m :: * -> *) o. (MonadIO m, IsTextBuffer o) => o -> m Int32
getTextBufferMaxLength o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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
"max-length"

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

-- | Construct a `GValueConstruct` with valid value for the “@max-length@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextBufferMaxLength :: (IsTextBuffer o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructTextBufferMaxLength :: forall o (m :: * -> *).
(IsTextBuffer o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructTextBufferMaxLength Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"max-length" Int32
val

#if defined(ENABLE_OVERLOADING)
data TextBufferMaxLengthPropertyInfo
instance AttrInfo TextBufferMaxLengthPropertyInfo where
    type AttrAllowedOps TextBufferMaxLengthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextBufferMaxLengthPropertyInfo = IsTextBuffer
    type AttrSetTypeConstraint TextBufferMaxLengthPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint TextBufferMaxLengthPropertyInfo = (~) Int32
    type AttrTransferType TextBufferMaxLengthPropertyInfo = Int32
    type AttrGetType TextBufferMaxLengthPropertyInfo = Int32
    type AttrLabel TextBufferMaxLengthPropertyInfo = "max-length"
    type AttrOrigin TextBufferMaxLengthPropertyInfo = TextBuffer
    attrGet = getTextBufferMaxLength
    attrSet = setTextBufferMaxLength
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextBufferMaxLength
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.maxLength"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#g:attr:maxLength"
        })
#endif

-- VVV Prop "text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,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 T.Text
getTextBufferText :: forall (m :: * -> *) o. (MonadIO m, IsTextBuffer o) => o -> m Text
getTextBufferText o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getTextBufferText" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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"

#if defined(ENABLE_OVERLOADING)
data TextBufferTextPropertyInfo
instance AttrInfo TextBufferTextPropertyInfo where
    type AttrAllowedOps TextBufferTextPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TextBufferTextPropertyInfo = IsTextBuffer
    type AttrSetTypeConstraint TextBufferTextPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TextBufferTextPropertyInfo = (~) ()
    type AttrTransferType TextBufferTextPropertyInfo = ()
    type AttrGetType TextBufferTextPropertyInfo = T.Text
    type AttrLabel TextBufferTextPropertyInfo = "text"
    type AttrOrigin TextBufferTextPropertyInfo = TextBuffer
    attrGet = getTextBufferText
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#g:attr:text"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TextBuffer
type instance O.AttributeList TextBuffer = TextBufferAttributeList
type TextBufferAttributeList = ('[ '("length", TextBufferLengthPropertyInfo), '("maxLength", TextBufferMaxLengthPropertyInfo), '("text", TextBufferTextPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
textBufferLength :: AttrLabelProxy "length"
textBufferLength = AttrLabelProxy

textBufferMaxLength :: AttrLabelProxy "maxLength"
textBufferMaxLength = AttrLabelProxy

textBufferText :: AttrLabelProxy "text"
textBufferText = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TextBuffer = TextBufferSignalList
type TextBufferSignalList = ('[ '("deletedText", TextBufferDeletedTextSignalInfo), '("insertedText", TextBufferInsertedTextSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method TextBuffer::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "TextBuffer" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_text_buffer_new" clutter_text_buffer_new :: 
    IO (Ptr TextBuffer)

-- | Create a new ClutterTextBuffer object.
-- 
-- /Since: 1.10/
textBufferNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m TextBuffer
    -- ^ __Returns:__ A new ClutterTextBuffer object.
textBufferNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m TextBuffer
textBufferNew  = IO TextBuffer -> m TextBuffer
forall a. IO a -> m a
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 TextBuffer
result <- IO (Ptr TextBuffer)
clutter_text_buffer_new
    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
    TextBuffer -> IO TextBuffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextBuffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TextBuffer::new_with_text
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "initial buffer text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text_len"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "initial buffer text length, or -1 for null-terminated."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "TextBuffer" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_text_buffer_new_with_text" clutter_text_buffer_new_with_text :: 
    CString ->                              -- text : TBasicType TUTF8
    Int64 ->                                -- text_len : TBasicType TInt64
    IO (Ptr TextBuffer)

-- | Create a new ClutterTextBuffer object with some text.
-- 
-- /Since: 1.10/
textBufferNewWithText ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@text@/: initial buffer text
    -> Int64
    -- ^ /@textLen@/: initial buffer text length, or -1 for null-terminated.
    -> m TextBuffer
    -- ^ __Returns:__ A new ClutterTextBuffer object.
textBufferNewWithText :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> Int64 -> m TextBuffer
textBufferNewWithText Maybe Text
text Int64
textLen = IO TextBuffer -> m TextBuffer
forall a. IO a -> m a
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
    CString
maybeText <- case Maybe Text
text of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jText -> do
            CString
jText' <- Text -> IO CString
textToCString Text
jText
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jText'
    Ptr TextBuffer
result <- CString -> Int64 -> IO (Ptr TextBuffer)
clutter_text_buffer_new_with_text CString
maybeText Int64
textLen
    Text -> Ptr TextBuffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textBufferNewWithText" 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
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeText
    TextBuffer -> IO TextBuffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextBuffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TextBuffer::delete_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterTextBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position at which to delete text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_chars"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of characters to delete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_text_buffer_delete_text" clutter_text_buffer_delete_text :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Clutter", name = "TextBuffer"})
    Word32 ->                               -- position : TBasicType TUInt
    Int32 ->                                -- n_chars : TBasicType TInt
    IO Word32

-- | Deletes a sequence of characters from the buffer. /@nChars@/ characters are
-- deleted starting at /@position@/. If /@nChars@/ is negative, then all characters
-- until the end of the text are deleted.
-- 
-- If /@position@/ or /@nChars@/ are out of bounds, then they are coerced to sane
-- values.
-- 
-- Note that the positions are specified in characters, not bytes.
-- 
-- /Since: 1.10/
textBufferDeleteText ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Clutter.Objects.TextBuffer.TextBuffer'
    -> Word32
    -- ^ /@position@/: position at which to delete text
    -> Int32
    -- ^ /@nChars@/: number of characters to delete
    -> m Word32
    -- ^ __Returns:__ The number of characters deleted.
textBufferDeleteText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> Word32 -> Int32 -> m Word32
textBufferDeleteText a
buffer Word32
position Int32
nChars = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
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
    Word32
result <- Ptr TextBuffer -> Word32 -> Int32 -> IO Word32
clutter_text_buffer_delete_text Ptr TextBuffer
buffer' Word32
position Int32
nChars
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TextBufferDeleteTextMethodInfo
instance (signature ~ (Word32 -> Int32 -> m Word32), MonadIO m, IsTextBuffer a) => O.OverloadedMethod TextBufferDeleteTextMethodInfo a signature where
    overloadedMethod = textBufferDeleteText

instance O.OverloadedMethodInfo TextBufferDeleteTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.textBufferDeleteText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#v:textBufferDeleteText"
        })


#endif

-- method TextBuffer::emit_deleted_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterTextBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position at which text was deleted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_chars"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of characters deleted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_text_buffer_emit_deleted_text" clutter_text_buffer_emit_deleted_text :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Clutter", name = "TextBuffer"})
    Word32 ->                               -- position : TBasicType TUInt
    Word32 ->                               -- n_chars : TBasicType TUInt
    IO ()

-- | Emits the [TextBuffer::deletedText]("GI.Clutter.Objects.TextBuffer#g:signal:deletedText") signal on /@buffer@/.
-- 
-- Used when subclassing t'GI.Clutter.Objects.TextBuffer.TextBuffer'
-- 
-- /Since: 1.10/
textBufferEmitDeletedText ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Clutter.Objects.TextBuffer.TextBuffer'
    -> Word32
    -- ^ /@position@/: position at which text was deleted
    -> Word32
    -- ^ /@nChars@/: number of characters deleted
    -> m ()
textBufferEmitDeletedText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> Word32 -> Word32 -> m ()
textBufferEmitDeletedText a
buffer Word32
position Word32
nChars = IO () -> m ()
forall a. IO a -> m a
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 -> TextBufferDeletedTextCallback
clutter_text_buffer_emit_deleted_text Ptr TextBuffer
buffer' Word32
position Word32
nChars
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferEmitDeletedTextMethodInfo
instance (signature ~ (Word32 -> Word32 -> m ()), MonadIO m, IsTextBuffer a) => O.OverloadedMethod TextBufferEmitDeletedTextMethodInfo a signature where
    overloadedMethod = textBufferEmitDeletedText

instance O.OverloadedMethodInfo TextBufferEmitDeletedTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.textBufferEmitDeletedText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#v:textBufferEmitDeletedText"
        })


#endif

-- method TextBuffer::emit_inserted_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterTextBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position at which text was inserted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chars"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "text that was inserted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_chars"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of characters inserted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_text_buffer_emit_inserted_text" clutter_text_buffer_emit_inserted_text :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Clutter", name = "TextBuffer"})
    Word32 ->                               -- position : TBasicType TUInt
    CString ->                              -- chars : TBasicType TUTF8
    Word32 ->                               -- n_chars : TBasicType TUInt
    IO ()

-- | Emits the [TextBuffer::insertedText]("GI.Clutter.Objects.TextBuffer#g:signal:insertedText") signal on /@buffer@/.
-- 
-- Used when subclassing t'GI.Clutter.Objects.TextBuffer.TextBuffer'
-- 
-- /Since: 1.10/
textBufferEmitInsertedText ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Clutter.Objects.TextBuffer.TextBuffer'
    -> Word32
    -- ^ /@position@/: position at which text was inserted
    -> T.Text
    -- ^ /@chars@/: text that was inserted
    -> Word32
    -- ^ /@nChars@/: number of characters inserted
    -> m ()
textBufferEmitInsertedText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> Word32 -> Text -> Word32 -> m ()
textBufferEmitInsertedText a
buffer Word32
position Text
chars Word32
nChars = IO () -> m ()
forall a. IO a -> m a
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
chars' <- Text -> IO CString
textToCString Text
chars
    Ptr TextBuffer -> Word32 -> CString -> Word32 -> IO ()
clutter_text_buffer_emit_inserted_text Ptr TextBuffer
buffer' Word32
position CString
chars' Word32
nChars
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
chars'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferEmitInsertedTextMethodInfo
instance (signature ~ (Word32 -> T.Text -> Word32 -> m ()), MonadIO m, IsTextBuffer a) => O.OverloadedMethod TextBufferEmitInsertedTextMethodInfo a signature where
    overloadedMethod = textBufferEmitInsertedText

instance O.OverloadedMethodInfo TextBufferEmitInsertedTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.textBufferEmitInsertedText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#v:textBufferEmitInsertedText"
        })


#endif

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

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

-- | Retrieves the length in bytes of the buffer.
-- See 'GI.Clutter.Objects.TextBuffer.textBufferGetLength'.
-- 
-- /Since: 1.10/
textBufferGetBytes ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Clutter.Objects.TextBuffer.TextBuffer'
    -> m Word64
    -- ^ __Returns:__ The byte length of the buffer.
textBufferGetBytes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> m Word64
textBufferGetBytes a
buffer = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
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
    Word64
result <- Ptr TextBuffer -> IO Word64
clutter_text_buffer_get_bytes Ptr TextBuffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data TextBufferGetBytesMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsTextBuffer a) => O.OverloadedMethod TextBufferGetBytesMethodInfo a signature where
    overloadedMethod = textBufferGetBytes

instance O.OverloadedMethodInfo TextBufferGetBytesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.textBufferGetBytes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#v:textBufferGetBytes"
        })


#endif

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

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

-- | Retrieves the length in characters of the buffer.
-- 
-- /Since: 1.10/
textBufferGetLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Clutter.Objects.TextBuffer.TextBuffer'
    -> m Word32
    -- ^ __Returns:__ The number of characters in the buffer.
textBufferGetLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> m Word32
textBufferGetLength a
buffer = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
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
    Word32
result <- Ptr TextBuffer -> IO Word32
clutter_text_buffer_get_length Ptr TextBuffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TextBufferGetLengthMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTextBuffer a) => O.OverloadedMethod TextBufferGetLengthMethodInfo a signature where
    overloadedMethod = textBufferGetLength

instance O.OverloadedMethodInfo TextBufferGetLengthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.textBufferGetLength",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#v:textBufferGetLength"
        })


#endif

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

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

-- | Retrieves the maximum allowed length of the text in
-- /@buffer@/. See 'GI.Clutter.Objects.TextBuffer.textBufferSetMaxLength'.
-- 
-- /Since: 1.10/
textBufferGetMaxLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Clutter.Objects.TextBuffer.TextBuffer'
    -> m Int32
    -- ^ __Returns:__ the maximum allowed number of characters
    --               in t'GI.Clutter.Objects.TextBuffer.TextBuffer', or 0 if there is no maximum.
textBufferGetMaxLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> m Int32
textBufferGetMaxLength a
buffer = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Int32
result <- Ptr TextBuffer -> IO Int32
clutter_text_buffer_get_max_length Ptr TextBuffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TextBufferGetMaxLengthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsTextBuffer a) => O.OverloadedMethod TextBufferGetMaxLengthMethodInfo a signature where
    overloadedMethod = textBufferGetMaxLength

instance O.OverloadedMethodInfo TextBufferGetMaxLengthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.textBufferGetMaxLength",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#v:textBufferGetMaxLength"
        })


#endif

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

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

-- | Retrieves the contents of the buffer.
-- 
-- The memory pointer returned by this call will not change
-- unless this object emits a signal, or is finalized.
-- 
-- /Since: 1.10/
textBufferGetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Clutter.Objects.TextBuffer.TextBuffer'
    -> m T.Text
    -- ^ __Returns:__ a pointer to the contents of the widget as a
    --      string. This string points to internally allocated
    --      storage in the buffer and must not be freed, modified or
    --      stored.
textBufferGetText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> m Text
textBufferGetText a
buffer = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
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
result <- Ptr TextBuffer -> IO CString
clutter_text_buffer_get_text Ptr TextBuffer
buffer'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textBufferGetText" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TextBufferGetTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsTextBuffer a) => O.OverloadedMethod TextBufferGetTextMethodInfo a signature where
    overloadedMethod = textBufferGetText

instance O.OverloadedMethodInfo TextBufferGetTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.textBufferGetText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#v:textBufferGetText"
        })


#endif

-- method TextBuffer::insert_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterTextBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position at which to insert text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chars"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the text to insert into the buffer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_chars"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the text in characters, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_text_buffer_insert_text" clutter_text_buffer_insert_text :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Clutter", name = "TextBuffer"})
    Word32 ->                               -- position : TBasicType TUInt
    CString ->                              -- chars : TBasicType TUTF8
    Int32 ->                                -- n_chars : TBasicType TInt
    IO Word32

-- | Inserts /@nChars@/ characters of /@chars@/ into the contents of the
-- buffer, at position /@position@/.
-- 
-- If /@nChars@/ is negative, then characters from chars will be inserted
-- until a null-terminator is found. If /@position@/ or /@nChars@/ are out of
-- bounds, or the maximum buffer text length is exceeded, then they are
-- coerced to sane values.
-- 
-- Note that the position and length are in characters, not in bytes.
-- 
-- /Since: 1.10/
textBufferInsertText ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Clutter.Objects.TextBuffer.TextBuffer'
    -> Word32
    -- ^ /@position@/: the position at which to insert text.
    -> T.Text
    -- ^ /@chars@/: the text to insert into the buffer.
    -> Int32
    -- ^ /@nChars@/: the length of the text in characters, or -1
    -> m Word32
    -- ^ __Returns:__ The number of characters actually inserted.
textBufferInsertText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> Word32 -> Text -> Int32 -> m Word32
textBufferInsertText a
buffer Word32
position Text
chars Int32
nChars = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
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
chars' <- Text -> IO CString
textToCString Text
chars
    Word32
result <- Ptr TextBuffer -> Word32 -> CString -> Int32 -> IO Word32
clutter_text_buffer_insert_text Ptr TextBuffer
buffer' Word32
position CString
chars' Int32
nChars
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
chars'
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TextBufferInsertTextMethodInfo
instance (signature ~ (Word32 -> T.Text -> Int32 -> m Word32), MonadIO m, IsTextBuffer a) => O.OverloadedMethod TextBufferInsertTextMethodInfo a signature where
    overloadedMethod = textBufferInsertText

instance O.OverloadedMethodInfo TextBufferInsertTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.textBufferInsertText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#v:textBufferInsertText"
        })


#endif

-- method TextBuffer::set_max_length
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterTextBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the maximum length of the entry buffer, or 0 for no maximum.\n  (other than the maximum length of entries.) The value passed in will\n  be clamped to the range [ 0, %CLUTTER_TEXT_BUFFER_MAX_SIZE ]."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_text_buffer_set_max_length" clutter_text_buffer_set_max_length :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Clutter", name = "TextBuffer"})
    Int32 ->                                -- max_length : TBasicType TInt
    IO ()

-- | Sets the maximum allowed length of the contents of the buffer. If
-- the current contents are longer than the given length, then they
-- will be truncated to fit.
-- 
-- /Since: 1.10/
textBufferSetMaxLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Clutter.Objects.TextBuffer.TextBuffer'
    -> Int32
    -- ^ /@maxLength@/: the maximum length of the entry buffer, or 0 for no maximum.
    --   (other than the maximum length of entries.) The value passed in will
    --   be clamped to the range [ 0, @/CLUTTER_TEXT_BUFFER_MAX_SIZE/@ ].
    -> m ()
textBufferSetMaxLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> Int32 -> m ()
textBufferSetMaxLength a
buffer Int32
maxLength = IO () -> m ()
forall a. IO a -> m a
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 -> Int32 -> IO ()
clutter_text_buffer_set_max_length Ptr TextBuffer
buffer' Int32
maxLength
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferSetMaxLengthMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsTextBuffer a) => O.OverloadedMethod TextBufferSetMaxLengthMethodInfo a signature where
    overloadedMethod = textBufferSetMaxLength

instance O.OverloadedMethodInfo TextBufferSetMaxLengthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.textBufferSetMaxLength",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#v:textBufferSetMaxLength"
        })


#endif

-- method TextBuffer::set_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterTextBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chars"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new text" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_chars"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of characters in @text, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_text_buffer_set_text" clutter_text_buffer_set_text :: 
    Ptr TextBuffer ->                       -- buffer : TInterface (Name {namespace = "Clutter", name = "TextBuffer"})
    CString ->                              -- chars : TBasicType TUTF8
    Int32 ->                                -- n_chars : TBasicType TInt
    IO ()

-- | Sets the text in the buffer.
-- 
-- This is roughly equivalent to calling 'GI.Clutter.Objects.TextBuffer.textBufferDeleteText'
-- and 'GI.Clutter.Objects.TextBuffer.textBufferInsertText'.
-- 
-- Note that /@nChars@/ is in characters, not in bytes.
-- 
-- /Since: 1.10/
textBufferSetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Clutter.Objects.TextBuffer.TextBuffer'
    -> T.Text
    -- ^ /@chars@/: the new text
    -> Int32
    -- ^ /@nChars@/: the number of characters in /@text@/, or -1
    -> m ()
textBufferSetText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> Text -> Int32 -> m ()
textBufferSetText a
buffer Text
chars Int32
nChars = IO () -> m ()
forall a. IO a -> m a
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
chars' <- Text -> IO CString
textToCString Text
chars
    Ptr TextBuffer -> CString -> Int32 -> IO ()
clutter_text_buffer_set_text Ptr TextBuffer
buffer' CString
chars' Int32
nChars
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
chars'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextBufferSetTextMethodInfo
instance (signature ~ (T.Text -> Int32 -> m ()), MonadIO m, IsTextBuffer a) => O.OverloadedMethod TextBufferSetTextMethodInfo a signature where
    overloadedMethod = textBufferSetText

instance O.OverloadedMethodInfo TextBufferSetTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.TextBuffer.textBufferSetText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-TextBuffer.html#v:textBufferSetText"
        })


#endif