{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gtk.Interfaces.Editable.Editable' interface is an interface which should be implemented by
-- text editing widgets, such as t'GI.Gtk.Objects.Entry.Entry' and t'GI.Gtk.Objects.SpinButton.SpinButton'. It contains functions
-- for generically manipulating an editable widget, a large number of action
-- signals used for key bindings, and several signals that an application can
-- connect to to modify the behavior of a widget.
-- 
-- As an example of the latter usage, by connecting
-- the following handler to [insertText]("GI.Gtk.Interfaces.Editable#signal:insertText"), an application
-- can convert all entry into a widget into uppercase.
-- 
-- == Forcing entry to uppercase.
-- 
-- 
-- === /C code/
-- >
-- >#include <ctype.h>;
-- >
-- >void
-- >insert_text_handler (GtkEditable *editable,
-- >                     const gchar *text,
-- >                     gint         length,
-- >                     gint        *position,
-- >                     gpointer     data)
-- >{
-- >  gchar *result = g_utf8_strup (text, length);
-- >
-- >  g_signal_handlers_block_by_func (editable,
-- >                               (gpointer) insert_text_handler, data);
-- >  gtk_editable_insert_text (editable, result, length, position);
-- >  g_signal_handlers_unblock_by_func (editable,
-- >                                     (gpointer) insert_text_handler, data);
-- >
-- >  g_signal_stop_emission_by_name (editable, "insert_text");
-- >
-- >  g_free (result);
-- >}
-- 

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

module GI.Gtk.Interfaces.Editable
    ( 

-- * Exported types
    Editable(..)                            ,
    noEditable                              ,
    IsEditable                              ,
    toEditable                              ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveEditableMethod                   ,
#endif


-- ** copyClipboard #method:copyClipboard#

#if defined(ENABLE_OVERLOADING)
    EditableCopyClipboardMethodInfo         ,
#endif
    editableCopyClipboard                   ,


-- ** cutClipboard #method:cutClipboard#

#if defined(ENABLE_OVERLOADING)
    EditableCutClipboardMethodInfo          ,
#endif
    editableCutClipboard                    ,


-- ** deleteSelection #method:deleteSelection#

#if defined(ENABLE_OVERLOADING)
    EditableDeleteSelectionMethodInfo       ,
#endif
    editableDeleteSelection                 ,


-- ** deleteText #method:deleteText#

#if defined(ENABLE_OVERLOADING)
    EditableDeleteTextMethodInfo            ,
#endif
    editableDeleteText                      ,


-- ** getChars #method:getChars#

#if defined(ENABLE_OVERLOADING)
    EditableGetCharsMethodInfo              ,
#endif
    editableGetChars                        ,


-- ** getEditable #method:getEditable#

#if defined(ENABLE_OVERLOADING)
    EditableGetEditableMethodInfo           ,
#endif
    editableGetEditable                     ,


-- ** getPosition #method:getPosition#

#if defined(ENABLE_OVERLOADING)
    EditableGetPositionMethodInfo           ,
#endif
    editableGetPosition                     ,


-- ** getSelectionBounds #method:getSelectionBounds#

#if defined(ENABLE_OVERLOADING)
    EditableGetSelectionBoundsMethodInfo    ,
#endif
    editableGetSelectionBounds              ,


-- ** insertText #method:insertText#

#if defined(ENABLE_OVERLOADING)
    EditableInsertTextMethodInfo            ,
#endif
    editableInsertText                      ,


-- ** pasteClipboard #method:pasteClipboard#

#if defined(ENABLE_OVERLOADING)
    EditablePasteClipboardMethodInfo        ,
#endif
    editablePasteClipboard                  ,


-- ** selectRegion #method:selectRegion#

#if defined(ENABLE_OVERLOADING)
    EditableSelectRegionMethodInfo          ,
#endif
    editableSelectRegion                    ,


-- ** setEditable #method:setEditable#

#if defined(ENABLE_OVERLOADING)
    EditableSetEditableMethodInfo           ,
#endif
    editableSetEditable                     ,


-- ** setPosition #method:setPosition#

#if defined(ENABLE_OVERLOADING)
    EditableSetPositionMethodInfo           ,
#endif
    editableSetPosition                     ,




 -- * Signals
-- ** changed #signal:changed#

    C_EditableChangedCallback               ,
    EditableChangedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    EditableChangedSignalInfo               ,
#endif
    afterEditableChanged                    ,
    genClosure_EditableChanged              ,
    mk_EditableChangedCallback              ,
    noEditableChangedCallback               ,
    onEditableChanged                       ,
    wrap_EditableChangedCallback            ,


-- ** deleteText #signal:deleteText#

    C_EditableDeleteTextCallback            ,
    EditableDeleteTextCallback              ,
#if defined(ENABLE_OVERLOADING)
    EditableDeleteTextSignalInfo            ,
#endif
    afterEditableDeleteText                 ,
    genClosure_EditableDeleteText           ,
    mk_EditableDeleteTextCallback           ,
    noEditableDeleteTextCallback            ,
    onEditableDeleteText                    ,
    wrap_EditableDeleteTextCallback         ,


-- ** insertText #signal:insertText#

    C_EditableInsertTextCallback            ,
    EditableInsertTextCallback              ,
#if defined(ENABLE_OVERLOADING)
    EditableInsertTextSignalInfo            ,
#endif
    afterEditableInsertText                 ,
    genClosure_EditableInsertText           ,
    mk_EditableInsertTextCallback           ,
    noEditableInsertTextCallback            ,
    onEditableInsertText                    ,
    wrap_EditableInsertTextCallback         ,




    ) 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.ManagedPtr as B.ManagedPtr
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 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.GObject.Objects.Object as GObject.Object

-- interface Editable 
-- | Memory-managed wrapper type.
newtype Editable = Editable (ManagedPtr Editable)
    deriving (Editable -> Editable -> Bool
(Editable -> Editable -> Bool)
-> (Editable -> Editable -> Bool) -> Eq Editable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Editable -> Editable -> Bool
$c/= :: Editable -> Editable -> Bool
== :: Editable -> Editable -> Bool
$c== :: Editable -> Editable -> Bool
Eq)
-- | A convenience alias for `Nothing` :: `Maybe` `Editable`.
noEditable :: Maybe Editable
noEditable :: Maybe Editable
noEditable = Maybe Editable
forall a. Maybe a
Nothing

-- signal Editable::changed
-- | The [changed](#signal:changed) signal is emitted at the end of a single
-- user-visible operation on the contents of the t'GI.Gtk.Interfaces.Editable.Editable'.
-- 
-- E.g., a paste operation that replaces the contents of the
-- selection will cause only one signal emission (even though it
-- is implemented by first deleting the selection, then inserting
-- the new content, and may cause multiple [notify](#signal:notify)[text](#signal:text) signals
-- to be emitted).
type EditableChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `EditableChangedCallback`@.
noEditableChangedCallback :: Maybe EditableChangedCallback
noEditableChangedCallback :: Maybe EditableChangedCallback
noEditableChangedCallback = Maybe EditableChangedCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_EditableChanged :: MonadIO m => EditableChangedCallback -> m (GClosure C_EditableChangedCallback)
genClosure_EditableChanged :: EditableChangedCallback -> m (GClosure C_EditableChangedCallback)
genClosure_EditableChanged cb :: EditableChangedCallback
cb = IO (GClosure C_EditableChangedCallback)
-> m (GClosure C_EditableChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_EditableChangedCallback)
 -> m (GClosure C_EditableChangedCallback))
-> IO (GClosure C_EditableChangedCallback)
-> m (GClosure C_EditableChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EditableChangedCallback
cb' = EditableChangedCallback -> C_EditableChangedCallback
wrap_EditableChangedCallback EditableChangedCallback
cb
    C_EditableChangedCallback -> IO (FunPtr C_EditableChangedCallback)
mk_EditableChangedCallback C_EditableChangedCallback
cb' IO (FunPtr C_EditableChangedCallback)
-> (FunPtr C_EditableChangedCallback
    -> IO (GClosure C_EditableChangedCallback))
-> IO (GClosure C_EditableChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_EditableChangedCallback
-> IO (GClosure C_EditableChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `EditableChangedCallback` into a `C_EditableChangedCallback`.
wrap_EditableChangedCallback ::
    EditableChangedCallback ->
    C_EditableChangedCallback
wrap_EditableChangedCallback :: EditableChangedCallback -> C_EditableChangedCallback
wrap_EditableChangedCallback _cb :: EditableChangedCallback
_cb _ _ = do
    EditableChangedCallback
_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' editable #changed callback
-- @
-- 
-- 
onEditableChanged :: (IsEditable a, MonadIO m) => a -> EditableChangedCallback -> m SignalHandlerId
onEditableChanged :: a -> EditableChangedCallback -> m SignalHandlerId
onEditableChanged obj :: a
obj cb :: EditableChangedCallback
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_EditableChangedCallback
cb' = EditableChangedCallback -> C_EditableChangedCallback
wrap_EditableChangedCallback EditableChangedCallback
cb
    FunPtr C_EditableChangedCallback
cb'' <- C_EditableChangedCallback -> IO (FunPtr C_EditableChangedCallback)
mk_EditableChangedCallback C_EditableChangedCallback
cb'
    a
-> Text
-> FunPtr C_EditableChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "changed" FunPtr C_EditableChangedCallback
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' editable #changed callback
-- @
-- 
-- 
afterEditableChanged :: (IsEditable a, MonadIO m) => a -> EditableChangedCallback -> m SignalHandlerId
afterEditableChanged :: a -> EditableChangedCallback -> m SignalHandlerId
afterEditableChanged obj :: a
obj cb :: EditableChangedCallback
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_EditableChangedCallback
cb' = EditableChangedCallback -> C_EditableChangedCallback
wrap_EditableChangedCallback EditableChangedCallback
cb
    FunPtr C_EditableChangedCallback
cb'' <- C_EditableChangedCallback -> IO (FunPtr C_EditableChangedCallback)
mk_EditableChangedCallback C_EditableChangedCallback
cb'
    a
-> Text
-> FunPtr C_EditableChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "changed" FunPtr C_EditableChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data EditableChangedSignalInfo
instance SignalInfo EditableChangedSignalInfo where
    type HaskellCallbackType EditableChangedSignalInfo = EditableChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_EditableChangedCallback cb
        cb'' <- mk_EditableChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail

#endif

-- signal Editable::delete-text
-- | This signal is emitted when text is deleted from
-- the widget by the user. The default handler for
-- this signal will normally be responsible for deleting
-- the text, so by connecting to this signal and then
-- stopping the signal with 'GI.GObject.Functions.signalStopEmission', it
-- is possible to modify the range of deleted text, or
-- prevent it from being deleted entirely. The /@startPos@/
-- and /@endPos@/ parameters are interpreted as for
-- 'GI.Gtk.Interfaces.Editable.editableDeleteText'.
type EditableDeleteTextCallback =
    Int32
    -- ^ /@startPos@/: the starting position
    -> Int32
    -- ^ /@endPos@/: the end position
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `EditableDeleteTextCallback`@.
noEditableDeleteTextCallback :: Maybe EditableDeleteTextCallback
noEditableDeleteTextCallback :: Maybe EditableDeleteTextCallback
noEditableDeleteTextCallback = Maybe EditableDeleteTextCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_EditableDeleteText :: MonadIO m => EditableDeleteTextCallback -> m (GClosure C_EditableDeleteTextCallback)
genClosure_EditableDeleteText :: EditableDeleteTextCallback
-> m (GClosure C_EditableDeleteTextCallback)
genClosure_EditableDeleteText cb :: EditableDeleteTextCallback
cb = IO (GClosure C_EditableDeleteTextCallback)
-> m (GClosure C_EditableDeleteTextCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_EditableDeleteTextCallback)
 -> m (GClosure C_EditableDeleteTextCallback))
-> IO (GClosure C_EditableDeleteTextCallback)
-> m (GClosure C_EditableDeleteTextCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EditableDeleteTextCallback
cb' = EditableDeleteTextCallback -> C_EditableDeleteTextCallback
wrap_EditableDeleteTextCallback EditableDeleteTextCallback
cb
    C_EditableDeleteTextCallback
-> IO (FunPtr C_EditableDeleteTextCallback)
mk_EditableDeleteTextCallback C_EditableDeleteTextCallback
cb' IO (FunPtr C_EditableDeleteTextCallback)
-> (FunPtr C_EditableDeleteTextCallback
    -> IO (GClosure C_EditableDeleteTextCallback))
-> IO (GClosure C_EditableDeleteTextCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_EditableDeleteTextCallback
-> IO (GClosure C_EditableDeleteTextCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `EditableDeleteTextCallback` into a `C_EditableDeleteTextCallback`.
wrap_EditableDeleteTextCallback ::
    EditableDeleteTextCallback ->
    C_EditableDeleteTextCallback
wrap_EditableDeleteTextCallback :: EditableDeleteTextCallback -> C_EditableDeleteTextCallback
wrap_EditableDeleteTextCallback _cb :: EditableDeleteTextCallback
_cb _ startPos :: Int32
startPos endPos :: Int32
endPos _ = do
    EditableDeleteTextCallback
_cb  Int32
startPos Int32
endPos


-- | Connect a signal handler for the [deleteText](#signal:deleteText) 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' editable #deleteText callback
-- @
-- 
-- 
onEditableDeleteText :: (IsEditable a, MonadIO m) => a -> EditableDeleteTextCallback -> m SignalHandlerId
onEditableDeleteText :: a -> EditableDeleteTextCallback -> m SignalHandlerId
onEditableDeleteText obj :: a
obj cb :: EditableDeleteTextCallback
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_EditableDeleteTextCallback
cb' = EditableDeleteTextCallback -> C_EditableDeleteTextCallback
wrap_EditableDeleteTextCallback EditableDeleteTextCallback
cb
    FunPtr C_EditableDeleteTextCallback
cb'' <- C_EditableDeleteTextCallback
-> IO (FunPtr C_EditableDeleteTextCallback)
mk_EditableDeleteTextCallback C_EditableDeleteTextCallback
cb'
    a
-> Text
-> FunPtr C_EditableDeleteTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "delete-text" FunPtr C_EditableDeleteTextCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deleteText](#signal:deleteText) 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' editable #deleteText callback
-- @
-- 
-- 
afterEditableDeleteText :: (IsEditable a, MonadIO m) => a -> EditableDeleteTextCallback -> m SignalHandlerId
afterEditableDeleteText :: a -> EditableDeleteTextCallback -> m SignalHandlerId
afterEditableDeleteText obj :: a
obj cb :: EditableDeleteTextCallback
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_EditableDeleteTextCallback
cb' = EditableDeleteTextCallback -> C_EditableDeleteTextCallback
wrap_EditableDeleteTextCallback EditableDeleteTextCallback
cb
    FunPtr C_EditableDeleteTextCallback
cb'' <- C_EditableDeleteTextCallback
-> IO (FunPtr C_EditableDeleteTextCallback)
mk_EditableDeleteTextCallback C_EditableDeleteTextCallback
cb'
    a
-> Text
-> FunPtr C_EditableDeleteTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "delete-text" FunPtr C_EditableDeleteTextCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data EditableDeleteTextSignalInfo
instance SignalInfo EditableDeleteTextSignalInfo where
    type HaskellCallbackType EditableDeleteTextSignalInfo = EditableDeleteTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_EditableDeleteTextCallback cb
        cb'' <- mk_EditableDeleteTextCallback cb'
        connectSignalFunPtr obj "delete-text" cb'' connectMode detail

#endif

-- signal Editable::insert-text
-- | This signal is emitted when text is inserted into
-- the widget by the user. The default handler for
-- this signal will normally be responsible for inserting
-- the text, so by connecting to this signal and then
-- stopping the signal with 'GI.GObject.Functions.signalStopEmission', it
-- is possible to modify the inserted text, or prevent
-- it from being inserted entirely.
type EditableInsertTextCallback =
    T.Text
    -- ^ /@newText@/: the new text to insert
    -> Int32
    -- ^ /@newTextLength@/: the length of the new text, in bytes,
    --     or -1 if new_text is nul-terminated
    -> Int32
    -- ^ /@position@/: the position, in characters,
    --     at which to insert the new text. this is an in-out
    --     parameter.  After the signal emission is finished, it
    --     should point after the newly inserted text.
    -> IO (Int32)

-- | A convenience synonym for @`Nothing` :: `Maybe` `EditableInsertTextCallback`@.
noEditableInsertTextCallback :: Maybe EditableInsertTextCallback
noEditableInsertTextCallback :: Maybe EditableInsertTextCallback
noEditableInsertTextCallback = Maybe EditableInsertTextCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_EditableInsertText :: MonadIO m => EditableInsertTextCallback -> m (GClosure C_EditableInsertTextCallback)
genClosure_EditableInsertText :: EditableInsertTextCallback
-> m (GClosure C_EditableInsertTextCallback)
genClosure_EditableInsertText cb :: EditableInsertTextCallback
cb = IO (GClosure C_EditableInsertTextCallback)
-> m (GClosure C_EditableInsertTextCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_EditableInsertTextCallback)
 -> m (GClosure C_EditableInsertTextCallback))
-> IO (GClosure C_EditableInsertTextCallback)
-> m (GClosure C_EditableInsertTextCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EditableInsertTextCallback
cb' = EditableInsertTextCallback -> C_EditableInsertTextCallback
wrap_EditableInsertTextCallback EditableInsertTextCallback
cb
    C_EditableInsertTextCallback
-> IO (FunPtr C_EditableInsertTextCallback)
mk_EditableInsertTextCallback C_EditableInsertTextCallback
cb' IO (FunPtr C_EditableInsertTextCallback)
-> (FunPtr C_EditableInsertTextCallback
    -> IO (GClosure C_EditableInsertTextCallback))
-> IO (GClosure C_EditableInsertTextCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_EditableInsertTextCallback
-> IO (GClosure C_EditableInsertTextCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `EditableInsertTextCallback` into a `C_EditableInsertTextCallback`.
wrap_EditableInsertTextCallback ::
    EditableInsertTextCallback ->
    C_EditableInsertTextCallback
wrap_EditableInsertTextCallback :: EditableInsertTextCallback -> C_EditableInsertTextCallback
wrap_EditableInsertTextCallback _cb :: EditableInsertTextCallback
_cb _ newText :: CString
newText newTextLength :: Int32
newTextLength position :: Ptr Int32
position _ = do
    Text
newText' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
newText
    Int32
position' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
position
    Int32
outposition <- EditableInsertTextCallback
_cb  Text
newText' Int32
newTextLength Int32
position'
    Ptr Int32 -> Int32 -> EditableChangedCallback
forall a. Storable a => Ptr a -> a -> EditableChangedCallback
poke Ptr Int32
position Int32
outposition


-- | 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' editable #insertText callback
-- @
-- 
-- 
onEditableInsertText :: (IsEditable a, MonadIO m) => a -> EditableInsertTextCallback -> m SignalHandlerId
onEditableInsertText :: a -> EditableInsertTextCallback -> m SignalHandlerId
onEditableInsertText obj :: a
obj cb :: EditableInsertTextCallback
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_EditableInsertTextCallback
cb' = EditableInsertTextCallback -> C_EditableInsertTextCallback
wrap_EditableInsertTextCallback EditableInsertTextCallback
cb
    FunPtr C_EditableInsertTextCallback
cb'' <- C_EditableInsertTextCallback
-> IO (FunPtr C_EditableInsertTextCallback)
mk_EditableInsertTextCallback C_EditableInsertTextCallback
cb'
    a
-> Text
-> FunPtr C_EditableInsertTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "insert-text" FunPtr C_EditableInsertTextCallback
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' editable #insertText callback
-- @
-- 
-- 
afterEditableInsertText :: (IsEditable a, MonadIO m) => a -> EditableInsertTextCallback -> m SignalHandlerId
afterEditableInsertText :: a -> EditableInsertTextCallback -> m SignalHandlerId
afterEditableInsertText obj :: a
obj cb :: EditableInsertTextCallback
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_EditableInsertTextCallback
cb' = EditableInsertTextCallback -> C_EditableInsertTextCallback
wrap_EditableInsertTextCallback EditableInsertTextCallback
cb
    FunPtr C_EditableInsertTextCallback
cb'' <- C_EditableInsertTextCallback
-> IO (FunPtr C_EditableInsertTextCallback)
mk_EditableInsertTextCallback C_EditableInsertTextCallback
cb'
    a
-> Text
-> FunPtr C_EditableInsertTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "insert-text" FunPtr C_EditableInsertTextCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data EditableInsertTextSignalInfo
instance SignalInfo EditableInsertTextSignalInfo where
    type HaskellCallbackType EditableInsertTextSignalInfo = EditableInsertTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_EditableInsertTextCallback cb
        cb'' <- mk_EditableInsertTextCallback cb'
        connectSignalFunPtr obj "insert-text" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Editable = EditableSignalList
type EditableSignalList = ('[ '("changed", EditableChangedSignalInfo), '("deleteText", EditableDeleteTextSignalInfo), '("insertText", EditableInsertTextSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

foreign import ccall "gtk_editable_get_type"
    c_gtk_editable_get_type :: IO GType

instance GObject Editable where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_editable_get_type
    

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

-- | Type class for types which can be safely cast to `Editable`, for instance with `toEditable`.
class (GObject o, O.IsDescendantOf Editable o) => IsEditable o
instance (GObject o, O.IsDescendantOf Editable o) => IsEditable o

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Editable
type instance O.AttributeList Editable = EditableAttributeList
type EditableAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveEditableMethod (t :: Symbol) (o :: *) :: * where
    ResolveEditableMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveEditableMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveEditableMethod "copyClipboard" o = EditableCopyClipboardMethodInfo
    ResolveEditableMethod "cutClipboard" o = EditableCutClipboardMethodInfo
    ResolveEditableMethod "deleteSelection" o = EditableDeleteSelectionMethodInfo
    ResolveEditableMethod "deleteText" o = EditableDeleteTextMethodInfo
    ResolveEditableMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveEditableMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveEditableMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveEditableMethod "insertText" o = EditableInsertTextMethodInfo
    ResolveEditableMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveEditableMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveEditableMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveEditableMethod "pasteClipboard" o = EditablePasteClipboardMethodInfo
    ResolveEditableMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveEditableMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveEditableMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveEditableMethod "selectRegion" o = EditableSelectRegionMethodInfo
    ResolveEditableMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveEditableMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveEditableMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveEditableMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveEditableMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveEditableMethod "getChars" o = EditableGetCharsMethodInfo
    ResolveEditableMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveEditableMethod "getEditable" o = EditableGetEditableMethodInfo
    ResolveEditableMethod "getPosition" o = EditableGetPositionMethodInfo
    ResolveEditableMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveEditableMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveEditableMethod "getSelectionBounds" o = EditableGetSelectionBoundsMethodInfo
    ResolveEditableMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveEditableMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveEditableMethod "setEditable" o = EditableSetEditableMethodInfo
    ResolveEditableMethod "setPosition" o = EditableSetPositionMethodInfo
    ResolveEditableMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveEditableMethod l o = O.MethodResolutionFailed l o

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

#endif

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

foreign import ccall "gtk_editable_copy_clipboard" gtk_editable_copy_clipboard :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    IO ()

-- | Copies the contents of the currently selected content in the editable and
-- puts it on the clipboard.
editableCopyClipboard ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m ()
editableCopyClipboard :: a -> m ()
editableCopyClipboard editable :: a
editable = EditableChangedCallback -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EditableChangedCallback -> m ())
-> EditableChangedCallback -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> EditableChangedCallback
gtk_editable_copy_clipboard Ptr Editable
editable'
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    () -> EditableChangedCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EditableCopyClipboardMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEditable a) => O.MethodInfo EditableCopyClipboardMethodInfo a signature where
    overloadedMethod = editableCopyClipboard

#endif

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

foreign import ccall "gtk_editable_cut_clipboard" gtk_editable_cut_clipboard :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    IO ()

-- | Removes the contents of the currently selected content in the editable and
-- puts it on the clipboard.
editableCutClipboard ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m ()
editableCutClipboard :: a -> m ()
editableCutClipboard editable :: a
editable = EditableChangedCallback -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EditableChangedCallback -> m ())
-> EditableChangedCallback -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> EditableChangedCallback
gtk_editable_cut_clipboard Ptr Editable
editable'
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    () -> EditableChangedCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EditableCutClipboardMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEditable a) => O.MethodInfo EditableCutClipboardMethodInfo a signature where
    overloadedMethod = editableCutClipboard

#endif

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

foreign import ccall "gtk_editable_delete_selection" gtk_editable_delete_selection :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    IO ()

-- | Deletes the currently selected text of the editable.
-- This call doesn’t do anything if there is no selected text.
editableDeleteSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m ()
editableDeleteSelection :: a -> m ()
editableDeleteSelection editable :: a
editable = EditableChangedCallback -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EditableChangedCallback -> m ())
-> EditableChangedCallback -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> EditableChangedCallback
gtk_editable_delete_selection Ptr Editable
editable'
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    () -> EditableChangedCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EditableDeleteSelectionMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEditable a) => O.MethodInfo EditableDeleteSelectionMethodInfo a signature where
    overloadedMethod = editableDeleteSelection

#endif

-- method Editable::delete_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "editable"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Editable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkEditable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_pos"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end_pos"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "end position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_editable_delete_text" gtk_editable_delete_text :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    Int32 ->                                -- start_pos : TBasicType TInt
    Int32 ->                                -- end_pos : TBasicType TInt
    IO ()

-- | Deletes a sequence of characters. The characters that are deleted are
-- those characters at positions from /@startPos@/ up to, but not including
-- /@endPos@/. If /@endPos@/ is negative, then the characters deleted
-- are those from /@startPos@/ to the end of the text.
-- 
-- Note that the positions are specified in characters, not bytes.
editableDeleteText ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> Int32
    -- ^ /@startPos@/: start position
    -> Int32
    -- ^ /@endPos@/: end position
    -> m ()
editableDeleteText :: a -> Int32 -> Int32 -> m ()
editableDeleteText editable :: a
editable startPos :: Int32
startPos endPos :: Int32
endPos = EditableChangedCallback -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EditableChangedCallback -> m ())
-> EditableChangedCallback -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> EditableDeleteTextCallback
gtk_editable_delete_text Ptr Editable
editable' Int32
startPos Int32
endPos
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    () -> EditableChangedCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EditableDeleteTextMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsEditable a) => O.MethodInfo EditableDeleteTextMethodInfo a signature where
    overloadedMethod = editableDeleteText

#endif

-- method Editable::get_chars
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "editable"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Editable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkEditable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_pos"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of text" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end_pos"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "end of text" , 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 "gtk_editable_get_chars" gtk_editable_get_chars :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    Int32 ->                                -- start_pos : TBasicType TInt
    Int32 ->                                -- end_pos : TBasicType TInt
    IO CString

-- | Retrieves a sequence of characters. The characters that are retrieved
-- are those characters at positions from /@startPos@/ up to, but not
-- including /@endPos@/. If /@endPos@/ is negative, then the characters
-- retrieved are those characters from /@startPos@/ to the end of the text.
-- 
-- Note that positions are specified in characters, not bytes.
editableGetChars ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> Int32
    -- ^ /@startPos@/: start of text
    -> Int32
    -- ^ /@endPos@/: end of text
    -> m T.Text
    -- ^ __Returns:__ a pointer to the contents of the widget as a
    --      string. This string is allocated by the t'GI.Gtk.Interfaces.Editable.Editable'
    --      implementation and should be freed by the caller.
editableGetChars :: a -> Int32 -> Int32 -> m Text
editableGetChars editable :: a
editable startPos :: Int32
startPos endPos :: Int32
endPos = IO Text -> m Text
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 Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    CString
result <- Ptr Editable -> Int32 -> Int32 -> IO CString
gtk_editable_get_chars Ptr Editable
editable' Int32
startPos Int32
endPos
    Text -> CString -> EditableChangedCallback
forall a. HasCallStack => Text -> Ptr a -> EditableChangedCallback
checkUnexpectedReturnNULL "editableGetChars" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> EditableChangedCallback
forall a. Ptr a -> EditableChangedCallback
freeMem CString
result
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EditableGetCharsMethodInfo
instance (signature ~ (Int32 -> Int32 -> m T.Text), MonadIO m, IsEditable a) => O.MethodInfo EditableGetCharsMethodInfo a signature where
    overloadedMethod = editableGetChars

#endif

-- method Editable::get_editable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "editable"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Editable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkEditable" , 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_editable_get_editable" gtk_editable_get_editable :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    IO CInt

-- | Retrieves whether /@editable@/ is editable. See
-- 'GI.Gtk.Interfaces.Editable.editableSetEditable'.
editableGetEditable ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@editable@/ is editable.
editableGetEditable :: a -> m Bool
editableGetEditable editable :: a
editable = 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 Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    CInt
result <- Ptr Editable -> IO CInt
gtk_editable_get_editable Ptr Editable
editable'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EditableGetEditableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEditable a) => O.MethodInfo EditableGetEditableMethodInfo a signature where
    overloadedMethod = editableGetEditable

#endif

-- method Editable::get_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "editable"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Editable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkEditable" , 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 "gtk_editable_get_position" gtk_editable_get_position :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    IO Int32

-- | Retrieves the current position of the cursor relative to the start
-- of the content of the editable.
-- 
-- Note that this position is in characters, not in bytes.
editableGetPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m Int32
    -- ^ __Returns:__ the cursor position
editableGetPosition :: a -> m Int32
editableGetPosition editable :: a
editable = 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
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Int32
result <- Ptr Editable -> IO Int32
gtk_editable_get_position Ptr Editable
editable'
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data EditableGetPositionMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsEditable a) => O.MethodInfo EditableGetPositionMethodInfo a signature where
    overloadedMethod = editableGetPosition

#endif

-- method Editable::get_selection_bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "editable"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Editable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkEditable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_pos"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location to store the starting position, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "end_pos"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the end position, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_editable_get_selection_bounds" gtk_editable_get_selection_bounds :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    Ptr Int32 ->                            -- start_pos : TBasicType TInt
    Ptr Int32 ->                            -- end_pos : TBasicType TInt
    IO CInt

-- | Retrieves the selection bound of the editable. start_pos will be filled
-- with the start of the selection and /@endPos@/ with end. If no text was
-- selected both will be identical and 'P.False' will be returned.
-- 
-- Note that positions are specified in characters, not bytes.
editableGetSelectionBounds ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m ((Bool, Int32, Int32))
    -- ^ __Returns:__ 'P.True' if an area is selected, 'P.False' otherwise
editableGetSelectionBounds :: a -> m (Bool, Int32, Int32)
editableGetSelectionBounds editable :: a
editable = IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32))
-> IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Int32
startPos <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
endPos <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr Editable -> Ptr Int32 -> Ptr Int32 -> IO CInt
gtk_editable_get_selection_bounds Ptr Editable
editable' Ptr Int32
startPos Ptr Int32
endPos
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Int32
startPos' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
startPos
    Int32
endPos' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
endPos
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    Ptr Int32 -> EditableChangedCallback
forall a. Ptr a -> EditableChangedCallback
freeMem Ptr Int32
startPos
    Ptr Int32 -> EditableChangedCallback
forall a. Ptr a -> EditableChangedCallback
freeMem Ptr Int32
endPos
    (Bool, Int32, Int32) -> IO (Bool, Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
startPos', Int32
endPos')

#if defined(ENABLE_OVERLOADING)
data EditableGetSelectionBoundsMethodInfo
instance (signature ~ (m ((Bool, Int32, Int32))), MonadIO m, IsEditable a) => O.MethodInfo EditableGetSelectionBoundsMethodInfo a signature where
    overloadedMethod = editableGetSelectionBounds

#endif

-- method Editable::insert_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "editable"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Editable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkEditable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the text to append" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_text_length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the text in bytes, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location of the position text will be inserted at"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_editable_insert_text" gtk_editable_insert_text :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    CString ->                              -- new_text : TBasicType TUTF8
    Int32 ->                                -- new_text_length : TBasicType TInt
    Ptr Int32 ->                            -- position : TBasicType TInt
    IO ()

-- | Inserts /@newTextLength@/ bytes of /@newText@/ into the contents of the
-- widget, at position /@position@/.
-- 
-- Note that the position is in characters, not in bytes.
-- The function updates /@position@/ to point after the newly inserted text.
editableInsertText ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> T.Text
    -- ^ /@newText@/: the text to append
    -> Int32
    -- ^ /@newTextLength@/: the length of the text in bytes, or -1
    -> Int32
    -- ^ /@position@/: location of the position text will be inserted at
    -> m (Int32)
editableInsertText :: a -> Text -> Int32 -> Int32 -> m Int32
editableInsertText editable :: a
editable newText :: Text
newText newTextLength :: Int32
newTextLength position :: Int32
position = 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
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    CString
newText' <- Text -> IO CString
textToCString Text
newText
    Ptr Int32
position' <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32 -> Int32 -> EditableChangedCallback
forall a. Storable a => Ptr a -> a -> EditableChangedCallback
poke Ptr Int32
position' Int32
position
    Ptr Editable
-> CString -> Int32 -> Ptr Int32 -> EditableChangedCallback
gtk_editable_insert_text Ptr Editable
editable' CString
newText' Int32
newTextLength Ptr Int32
position'
    Int32
position'' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
position'
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    CString -> EditableChangedCallback
forall a. Ptr a -> EditableChangedCallback
freeMem CString
newText'
    Ptr Int32 -> EditableChangedCallback
forall a. Ptr a -> EditableChangedCallback
freeMem Ptr Int32
position'
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
position''

#if defined(ENABLE_OVERLOADING)
data EditableInsertTextMethodInfo
instance (signature ~ (T.Text -> Int32 -> Int32 -> m (Int32)), MonadIO m, IsEditable a) => O.MethodInfo EditableInsertTextMethodInfo a signature where
    overloadedMethod = editableInsertText

#endif

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

foreign import ccall "gtk_editable_paste_clipboard" gtk_editable_paste_clipboard :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    IO ()

-- | Pastes the content of the clipboard to the current position of the
-- cursor in the editable.
editablePasteClipboard ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m ()
editablePasteClipboard :: a -> m ()
editablePasteClipboard editable :: a
editable = EditableChangedCallback -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EditableChangedCallback -> m ())
-> EditableChangedCallback -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> EditableChangedCallback
gtk_editable_paste_clipboard Ptr Editable
editable'
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    () -> EditableChangedCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EditablePasteClipboardMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEditable a) => O.MethodInfo EditablePasteClipboardMethodInfo a signature where
    overloadedMethod = editablePasteClipboard

#endif

-- method Editable::select_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "editable"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Editable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkEditable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_pos"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of region" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end_pos"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "end of region" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_editable_select_region" gtk_editable_select_region :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    Int32 ->                                -- start_pos : TBasicType TInt
    Int32 ->                                -- end_pos : TBasicType TInt
    IO ()

-- | Selects a region of text. The characters that are selected are
-- those characters at positions from /@startPos@/ up to, but not
-- including /@endPos@/. If /@endPos@/ is negative, then the
-- characters selected are those characters from /@startPos@/ to
-- the end of the text.
-- 
-- Note that positions are specified in characters, not bytes.
editableSelectRegion ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> Int32
    -- ^ /@startPos@/: start of region
    -> Int32
    -- ^ /@endPos@/: end of region
    -> m ()
editableSelectRegion :: a -> Int32 -> Int32 -> m ()
editableSelectRegion editable :: a
editable startPos :: Int32
startPos endPos :: Int32
endPos = EditableChangedCallback -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EditableChangedCallback -> m ())
-> EditableChangedCallback -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> EditableDeleteTextCallback
gtk_editable_select_region Ptr Editable
editable' Int32
startPos Int32
endPos
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    () -> EditableChangedCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EditableSelectRegionMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsEditable a) => O.MethodInfo EditableSelectRegionMethodInfo a signature where
    overloadedMethod = editableSelectRegion

#endif

-- method Editable::set_editable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "editable"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Editable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkEditable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_editable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%TRUE if the user is allowed to edit the text\n  in the widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_editable_set_editable" gtk_editable_set_editable :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    CInt ->                                 -- is_editable : TBasicType TBoolean
    IO ()

-- | Determines if the user can edit the text in the editable
-- widget or not.
editableSetEditable ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> Bool
    -- ^ /@isEditable@/: 'P.True' if the user is allowed to edit the text
    --   in the widget
    -> m ()
editableSetEditable :: a -> Bool -> m ()
editableSetEditable editable :: a
editable isEditable :: Bool
isEditable = EditableChangedCallback -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EditableChangedCallback -> m ())
-> EditableChangedCallback -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    let isEditable' :: CInt
isEditable' = (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
isEditable
    Ptr Editable -> CInt -> EditableChangedCallback
gtk_editable_set_editable Ptr Editable
editable' CInt
isEditable'
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    () -> EditableChangedCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EditableSetEditableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEditable a) => O.MethodInfo EditableSetEditableMethodInfo a signature where
    overloadedMethod = editableSetEditable

#endif

-- method Editable::set_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "editable"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Editable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkEditable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position of the cursor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_editable_set_position" gtk_editable_set_position :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    Int32 ->                                -- position : TBasicType TInt
    IO ()

-- | Sets the cursor position in the editable to the given value.
-- 
-- The cursor is displayed before the character with the given (base 0)
-- index in the contents of the editable. The value must be less than or
-- equal to the number of characters in the editable. A value of -1
-- indicates that the position should be set after the last character
-- of the editable. Note that /@position@/ is in characters, not in bytes.
editableSetPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> Int32
    -- ^ /@position@/: the position of the cursor
    -> m ()
editableSetPosition :: a -> Int32 -> m ()
editableSetPosition editable :: a
editable position :: Int32
position = EditableChangedCallback -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EditableChangedCallback -> m ())
-> EditableChangedCallback -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> Int32 -> EditableChangedCallback
gtk_editable_set_position Ptr Editable
editable' Int32
position
    a -> EditableChangedCallback
forall a. ManagedPtrNewtype a => a -> EditableChangedCallback
touchManagedPtr a
editable
    () -> EditableChangedCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EditableSetPositionMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsEditable a) => O.MethodInfo EditableSetPositionMethodInfo a signature where
    overloadedMethod = editableSetPosition

#endif