{-# 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#g: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 char  *text,
-- >                     int          length,
-- >                     int         *position,
-- >                     gpointer     data)
-- >{
-- >  char *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);
-- >}
-- 
-- 
-- == Implementing GtkEditable
-- 
-- The most likely scenario for implementing GtkEditable on your own widget
-- is that you will embed a t'GI.Gtk.Objects.Text.Text' inside a complex widget, and want to
-- delegate the editable functionality to that text widget. GtkEditable
-- provides some utility functions to make this easy.
-- 
-- In your class_init function, call 'GI.Gtk.Functions.editableInstallProperties',
-- passing the first available property ID:
-- 
-- >
-- >static void
-- >my_class_init (MyClass *class)
-- >{
-- >   ...
-- >   g_object_class_install_properties (object_class, NUM_PROPERTIES, props);
-- >   gtk_editable_install_properties (object_clas, NUM_PROPERTIES);
-- >   ...
-- >}
-- 
-- 
-- In your interface_init function for the GtkEditable interface, provide
-- an implementation for the get_delegate vfunc that returns your text widget:
-- 
-- >
-- >GtkEditable *
-- >get_editable_delegate (GtkEditable *editable)
-- >{
-- >  return GTK_EDITABLE (MY_WIDGET (editable)->text_widget);
-- >}
-- >
-- >static void
-- >my_editable_init (GtkEditableInterface *iface)
-- >{
-- >  iface->get_delegate = get_editable_delegate;
-- >}
-- 
-- 
-- You don\'t need to provide any other vfuncs. The default implementations
-- work by forwarding to the delegate that the t'GI.Gtk.Structs.EditableInterface.EditableInterface'.@/get_delegate/@()
-- vfunc returns.
-- 
-- In your instance_init function, create your text widget, and then call
-- 'GI.Gtk.Interfaces.Editable.editableInitDelegate':
-- 
-- >
-- >static void
-- >my_widget_init (MyWidget *self)
-- >{
-- >  ...
-- >  self->text_widget = gtk_text_new ();
-- >  gtk_editable_init_delegate (GTK_EDITABLE (self));
-- >  ...
-- >}
-- 
-- 
-- In your dispose function, call 'GI.Gtk.Interfaces.Editable.editableFinishDelegate' before
-- destroying your text widget:
-- 
-- >
-- >static void
-- >my_widget_dispose (GObject *object)
-- >{
-- >  ...
-- >  gtk_editable_finish_delegate (GTK_EDITABLE (self));
-- >  g_clear_pointer (&self->text_widget, gtk_widget_unparent);
-- >  ...
-- >}
-- 
-- 
-- Finally, use 'GI.Gtk.Functions.editableDelegateSetProperty' in your set_property
-- function (and similar for get_property), to set the editable properties:
-- 
-- >
-- >  ...
-- >  if (gtk_editable_delegate_set_property (object, prop_id, value, pspec))
-- >    return;
-- >
-- >  switch (prop_id)
-- >  ...
-- 

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

module GI.Gtk.Interfaces.Editable
    ( 

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


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

#if defined(ENABLE_OVERLOADING)
    ResolveEditableMethod                   ,
#endif


-- ** delegateGetProperty #method:delegateGetProperty#

    editableDelegateGetProperty             ,


-- ** delegateSetProperty #method:delegateSetProperty#

    editableDelegateSetProperty             ,


-- ** deleteSelection #method:deleteSelection#

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


-- ** deleteText #method:deleteText#

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


-- ** finishDelegate #method:finishDelegate#

#if defined(ENABLE_OVERLOADING)
    EditableFinishDelegateMethodInfo        ,
#endif
    editableFinishDelegate                  ,


-- ** getAlignment #method:getAlignment#

#if defined(ENABLE_OVERLOADING)
    EditableGetAlignmentMethodInfo          ,
#endif
    editableGetAlignment                    ,


-- ** getChars #method:getChars#

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


-- ** getEditable #method:getEditable#

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


-- ** getEnableUndo #method:getEnableUndo#

#if defined(ENABLE_OVERLOADING)
    EditableGetEnableUndoMethodInfo         ,
#endif
    editableGetEnableUndo                   ,


-- ** getMaxWidthChars #method:getMaxWidthChars#

#if defined(ENABLE_OVERLOADING)
    EditableGetMaxWidthCharsMethodInfo      ,
#endif
    editableGetMaxWidthChars                ,


-- ** getPosition #method:getPosition#

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


-- ** getSelectionBounds #method:getSelectionBounds#

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


-- ** getText #method:getText#

#if defined(ENABLE_OVERLOADING)
    EditableGetTextMethodInfo               ,
#endif
    editableGetText                         ,


-- ** getWidthChars #method:getWidthChars#

#if defined(ENABLE_OVERLOADING)
    EditableGetWidthCharsMethodInfo         ,
#endif
    editableGetWidthChars                   ,


-- ** initDelegate #method:initDelegate#

#if defined(ENABLE_OVERLOADING)
    EditableInitDelegateMethodInfo          ,
#endif
    editableInitDelegate                    ,


-- ** insertText #method:insertText#

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


-- ** installProperties #method:installProperties#

    editableInstallProperties               ,


-- ** selectRegion #method:selectRegion#

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


-- ** setAlignment #method:setAlignment#

#if defined(ENABLE_OVERLOADING)
    EditableSetAlignmentMethodInfo          ,
#endif
    editableSetAlignment                    ,


-- ** setEditable #method:setEditable#

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


-- ** setEnableUndo #method:setEnableUndo#

#if defined(ENABLE_OVERLOADING)
    EditableSetEnableUndoMethodInfo         ,
#endif
    editableSetEnableUndo                   ,


-- ** setMaxWidthChars #method:setMaxWidthChars#

#if defined(ENABLE_OVERLOADING)
    EditableSetMaxWidthCharsMethodInfo      ,
#endif
    editableSetMaxWidthChars                ,


-- ** setPosition #method:setPosition#

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


-- ** setText #method:setText#

#if defined(ENABLE_OVERLOADING)
    EditableSetTextMethodInfo               ,
#endif
    editableSetText                         ,


-- ** setWidthChars #method:setWidthChars#

#if defined(ENABLE_OVERLOADING)
    EditableSetWidthCharsMethodInfo         ,
#endif
    editableSetWidthChars                   ,




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

#if defined(ENABLE_OVERLOADING)
    EditableCursorPositionPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    editableCursorPosition                  ,
#endif
    getEditableCursorPosition               ,


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

#if defined(ENABLE_OVERLOADING)
    EditableEditablePropertyInfo            ,
#endif
    constructEditableEditable               ,
#if defined(ENABLE_OVERLOADING)
    editableEditable                        ,
#endif
    getEditableEditable                     ,
    setEditableEditable                     ,


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

#if defined(ENABLE_OVERLOADING)
    EditableEnableUndoPropertyInfo          ,
#endif
    constructEditableEnableUndo             ,
#if defined(ENABLE_OVERLOADING)
    editableEnableUndo                      ,
#endif
    getEditableEnableUndo                   ,
    setEditableEnableUndo                   ,


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

#if defined(ENABLE_OVERLOADING)
    EditableMaxWidthCharsPropertyInfo       ,
#endif
    constructEditableMaxWidthChars          ,
#if defined(ENABLE_OVERLOADING)
    editableMaxWidthChars                   ,
#endif
    getEditableMaxWidthChars                ,
    setEditableMaxWidthChars                ,


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

#if defined(ENABLE_OVERLOADING)
    EditableSelectionBoundPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    editableSelectionBound                  ,
#endif
    getEditableSelectionBound               ,


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

#if defined(ENABLE_OVERLOADING)
    EditableTextPropertyInfo                ,
#endif
    constructEditableText                   ,
#if defined(ENABLE_OVERLOADING)
    editableText                            ,
#endif
    getEditableText                         ,
    setEditableText                         ,


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

#if defined(ENABLE_OVERLOADING)
    EditableWidthCharsPropertyInfo          ,
#endif
    constructEditableWidthChars             ,
#if defined(ENABLE_OVERLOADING)
    editableWidthChars                      ,
#endif
    getEditableWidthChars                   ,
    setEditableWidthChars                   ,


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

#if defined(ENABLE_OVERLOADING)
    EditableXalignPropertyInfo              ,
#endif
    constructEditableXalign                 ,
#if defined(ENABLE_OVERLOADING)
    editableXalign                          ,
#endif
    getEditableXalign                       ,
    setEditableXalign                       ,




 -- * 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.BasicTypes as B.Types
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 Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GObject.Structs.ObjectClass as GObject.ObjectClass
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

-- interface Editable 
-- | Memory-managed wrapper type.
newtype Editable = Editable (SP.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)

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

foreign import ccall "gtk_editable_get_type"
    c_gtk_editable_get_type :: IO B.Types.GType

instance B.Types.TypedObject Editable where
    glibType :: IO GType
glibType = IO GType
c_gtk_editable_get_type

instance B.Types.GObject Editable

-- | 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 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 -> IO ()) -> Ptr Editable -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Editable -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Editable
fromGValue 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 (SP.GObject o, O.IsDescendantOf Editable o) => IsEditable o
instance (SP.GObject o, O.IsDescendantOf Editable o) => IsEditable o

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

-- | 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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Editable -> Editable
Editable

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

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

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

-- VVV Prop "editable"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@editable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEditableEditable :: (IsEditable o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEditableEditable :: Bool -> m (GValueConstruct o)
constructEditableEditable Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"editable" Bool
val

#if defined(ENABLE_OVERLOADING)
data EditableEditablePropertyInfo
instance AttrInfo EditableEditablePropertyInfo where
    type AttrAllowedOps EditableEditablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EditableEditablePropertyInfo = IsEditable
    type AttrSetTypeConstraint EditableEditablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EditableEditablePropertyInfo = (~) Bool
    type AttrTransferType EditableEditablePropertyInfo = Bool
    type AttrGetType EditableEditablePropertyInfo = Bool
    type AttrLabel EditableEditablePropertyInfo = "editable"
    type AttrOrigin EditableEditablePropertyInfo = Editable
    attrGet = getEditableEditable
    attrSet = setEditableEditable
    attrTransfer _ v = do
        return v
    attrConstruct = constructEditableEditable
    attrClear = undefined
#endif

-- VVV Prop "enable-undo"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@enable-undo@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' editable [ #enableUndo 'Data.GI.Base.Attributes.:=' value ]
-- @
setEditableEnableUndo :: (MonadIO m, IsEditable o) => o -> Bool -> m ()
setEditableEnableUndo :: o -> Bool -> m ()
setEditableEnableUndo o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"enable-undo" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@enable-undo@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEditableEnableUndo :: (IsEditable o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEditableEnableUndo :: Bool -> m (GValueConstruct o)
constructEditableEnableUndo Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"enable-undo" Bool
val

#if defined(ENABLE_OVERLOADING)
data EditableEnableUndoPropertyInfo
instance AttrInfo EditableEnableUndoPropertyInfo where
    type AttrAllowedOps EditableEnableUndoPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EditableEnableUndoPropertyInfo = IsEditable
    type AttrSetTypeConstraint EditableEnableUndoPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EditableEnableUndoPropertyInfo = (~) Bool
    type AttrTransferType EditableEnableUndoPropertyInfo = Bool
    type AttrGetType EditableEnableUndoPropertyInfo = Bool
    type AttrLabel EditableEnableUndoPropertyInfo = "enable-undo"
    type AttrOrigin EditableEnableUndoPropertyInfo = Editable
    attrGet = getEditableEnableUndo
    attrSet = setEditableEnableUndo
    attrTransfer _ v = do
        return v
    attrConstruct = constructEditableEnableUndo
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data EditableMaxWidthCharsPropertyInfo
instance AttrInfo EditableMaxWidthCharsPropertyInfo where
    type AttrAllowedOps EditableMaxWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EditableMaxWidthCharsPropertyInfo = IsEditable
    type AttrSetTypeConstraint EditableMaxWidthCharsPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint EditableMaxWidthCharsPropertyInfo = (~) Int32
    type AttrTransferType EditableMaxWidthCharsPropertyInfo = Int32
    type AttrGetType EditableMaxWidthCharsPropertyInfo = Int32
    type AttrLabel EditableMaxWidthCharsPropertyInfo = "max-width-chars"
    type AttrOrigin EditableMaxWidthCharsPropertyInfo = Editable
    attrGet = getEditableMaxWidthChars
    attrSet = setEditableMaxWidthChars
    attrTransfer _ v = do
        return v
    attrConstruct = constructEditableMaxWidthChars
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data EditableSelectionBoundPropertyInfo
instance AttrInfo EditableSelectionBoundPropertyInfo where
    type AttrAllowedOps EditableSelectionBoundPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint EditableSelectionBoundPropertyInfo = IsEditable
    type AttrSetTypeConstraint EditableSelectionBoundPropertyInfo = (~) ()
    type AttrTransferTypeConstraint EditableSelectionBoundPropertyInfo = (~) ()
    type AttrTransferType EditableSelectionBoundPropertyInfo = ()
    type AttrGetType EditableSelectionBoundPropertyInfo = Int32
    type AttrLabel EditableSelectionBoundPropertyInfo = "selection-bound"
    type AttrOrigin EditableSelectionBoundPropertyInfo = Editable
    attrGet = getEditableSelectionBound
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

-- | 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' editable #text
-- @
getEditableText :: (MonadIO m, IsEditable o) => o -> m T.Text
getEditableText :: o -> m Text
getEditableText o
obj = 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
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getEditableText" (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"

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

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

#if defined(ENABLE_OVERLOADING)
data EditableTextPropertyInfo
instance AttrInfo EditableTextPropertyInfo where
    type AttrAllowedOps EditableTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EditableTextPropertyInfo = IsEditable
    type AttrSetTypeConstraint EditableTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EditableTextPropertyInfo = (~) T.Text
    type AttrTransferType EditableTextPropertyInfo = T.Text
    type AttrGetType EditableTextPropertyInfo = T.Text
    type AttrLabel EditableTextPropertyInfo = "text"
    type AttrOrigin EditableTextPropertyInfo = Editable
    attrGet = getEditableText
    attrSet = setEditableText
    attrTransfer _ v = do
        return v
    attrConstruct = constructEditableText
    attrClear = undefined
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@width-chars@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEditableWidthChars :: (IsEditable o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructEditableWidthChars :: Int32 -> m (GValueConstruct o)
constructEditableWidthChars Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"width-chars" Int32
val

#if defined(ENABLE_OVERLOADING)
data EditableWidthCharsPropertyInfo
instance AttrInfo EditableWidthCharsPropertyInfo where
    type AttrAllowedOps EditableWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EditableWidthCharsPropertyInfo = IsEditable
    type AttrSetTypeConstraint EditableWidthCharsPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint EditableWidthCharsPropertyInfo = (~) Int32
    type AttrTransferType EditableWidthCharsPropertyInfo = Int32
    type AttrGetType EditableWidthCharsPropertyInfo = Int32
    type AttrLabel EditableWidthCharsPropertyInfo = "width-chars"
    type AttrOrigin EditableWidthCharsPropertyInfo = Editable
    attrGet = getEditableWidthChars
    attrSet = setEditableWidthChars
    attrTransfer _ v = do
        return v
    attrConstruct = constructEditableWidthChars
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@xalign@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' editable [ #xalign 'Data.GI.Base.Attributes.:=' value ]
-- @
setEditableXalign :: (MonadIO m, IsEditable o) => o -> Float -> m ()
setEditableXalign :: o -> Float -> m ()
setEditableXalign o
obj Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"xalign" Float
val

-- | Construct a `GValueConstruct` with valid value for the “@xalign@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEditableXalign :: (IsEditable o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructEditableXalign :: Float -> m (GValueConstruct o)
constructEditableXalign Float
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"xalign" Float
val

#if defined(ENABLE_OVERLOADING)
data EditableXalignPropertyInfo
instance AttrInfo EditableXalignPropertyInfo where
    type AttrAllowedOps EditableXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EditableXalignPropertyInfo = IsEditable
    type AttrSetTypeConstraint EditableXalignPropertyInfo = (~) Float
    type AttrTransferTypeConstraint EditableXalignPropertyInfo = (~) Float
    type AttrTransferType EditableXalignPropertyInfo = Float
    type AttrGetType EditableXalignPropertyInfo = Float
    type AttrLabel EditableXalignPropertyInfo = "xalign"
    type AttrOrigin EditableXalignPropertyInfo = Editable
    attrGet = getEditableXalign
    attrSet = setEditableXalign
    attrTransfer _ v = do
        return v
    attrConstruct = constructEditableXalign
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Editable
type instance O.AttributeList Editable = EditableAttributeList
type EditableAttributeList = ('[ '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("cursorPosition", EditableCursorPositionPropertyInfo), '("editable", EditableEditablePropertyInfo), '("enableUndo", EditableEnableUndoPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("maxWidthChars", EditableMaxWidthCharsPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("selectionBound", EditableSelectionBoundPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("text", EditableTextPropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthChars", EditableWidthCharsPropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo), '("xalign", EditableXalignPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
editableCursorPosition :: AttrLabelProxy "cursorPosition"
editableCursorPosition = AttrLabelProxy

editableEditable :: AttrLabelProxy "editable"
editableEditable = AttrLabelProxy

editableEnableUndo :: AttrLabelProxy "enableUndo"
editableEnableUndo = AttrLabelProxy

editableMaxWidthChars :: AttrLabelProxy "maxWidthChars"
editableMaxWidthChars = AttrLabelProxy

editableSelectionBound :: AttrLabelProxy "selectionBound"
editableSelectionBound = AttrLabelProxy

editableText :: AttrLabelProxy "text"
editableText = AttrLabelProxy

editableWidthChars :: AttrLabelProxy "widthChars"
editableWidthChars = AttrLabelProxy

editableXalign :: AttrLabelProxy "xalign"
editableXalign = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveEditableMethod (t :: Symbol) (o :: *) :: * where
    ResolveEditableMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveEditableMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveEditableMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveEditableMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveEditableMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveEditableMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveEditableMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveEditableMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveEditableMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveEditableMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveEditableMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveEditableMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveEditableMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveEditableMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveEditableMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveEditableMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveEditableMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveEditableMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveEditableMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveEditableMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveEditableMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveEditableMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveEditableMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveEditableMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveEditableMethod "deleteSelection" o = EditableDeleteSelectionMethodInfo
    ResolveEditableMethod "deleteText" o = EditableDeleteTextMethodInfo
    ResolveEditableMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveEditableMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveEditableMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveEditableMethod "finishDelegate" o = EditableFinishDelegateMethodInfo
    ResolveEditableMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveEditableMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveEditableMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveEditableMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveEditableMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveEditableMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveEditableMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveEditableMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveEditableMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveEditableMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveEditableMethod "initDelegate" o = EditableInitDelegateMethodInfo
    ResolveEditableMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveEditableMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveEditableMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveEditableMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveEditableMethod "insertText" o = EditableInsertTextMethodInfo
    ResolveEditableMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveEditableMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveEditableMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveEditableMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveEditableMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveEditableMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveEditableMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveEditableMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveEditableMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveEditableMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveEditableMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveEditableMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveEditableMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveEditableMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveEditableMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveEditableMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveEditableMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveEditableMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveEditableMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveEditableMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveEditableMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveEditableMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveEditableMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveEditableMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveEditableMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveEditableMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveEditableMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveEditableMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveEditableMethod "selectRegion" o = EditableSelectRegionMethodInfo
    ResolveEditableMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolveEditableMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveEditableMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveEditableMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveEditableMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveEditableMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveEditableMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveEditableMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveEditableMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveEditableMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveEditableMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveEditableMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveEditableMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveEditableMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveEditableMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveEditableMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveEditableMethod "getAlignment" o = EditableGetAlignmentMethodInfo
    ResolveEditableMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveEditableMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveEditableMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveEditableMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveEditableMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveEditableMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveEditableMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveEditableMethod "getChars" o = EditableGetCharsMethodInfo
    ResolveEditableMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveEditableMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveEditableMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveEditableMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveEditableMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveEditableMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveEditableMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveEditableMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveEditableMethod "getEditable" o = EditableGetEditableMethodInfo
    ResolveEditableMethod "getEnableUndo" o = EditableGetEnableUndoMethodInfo
    ResolveEditableMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveEditableMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveEditableMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveEditableMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolveEditableMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveEditableMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveEditableMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveEditableMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveEditableMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveEditableMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveEditableMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveEditableMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveEditableMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveEditableMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveEditableMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveEditableMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveEditableMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveEditableMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveEditableMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveEditableMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveEditableMethod "getMaxWidthChars" o = EditableGetMaxWidthCharsMethodInfo
    ResolveEditableMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveEditableMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveEditableMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveEditableMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveEditableMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveEditableMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveEditableMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveEditableMethod "getPosition" o = EditableGetPositionMethodInfo
    ResolveEditableMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveEditableMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveEditableMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveEditableMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveEditableMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveEditableMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveEditableMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveEditableMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveEditableMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveEditableMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveEditableMethod "getSelectionBounds" o = EditableGetSelectionBoundsMethodInfo
    ResolveEditableMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveEditableMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveEditableMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveEditableMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveEditableMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveEditableMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveEditableMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveEditableMethod "getText" o = EditableGetTextMethodInfo
    ResolveEditableMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveEditableMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveEditableMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveEditableMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveEditableMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveEditableMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveEditableMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveEditableMethod "getWidthChars" o = EditableGetWidthCharsMethodInfo
    ResolveEditableMethod "setAlignment" o = EditableSetAlignmentMethodInfo
    ResolveEditableMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveEditableMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveEditableMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveEditableMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveEditableMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolveEditableMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveEditableMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveEditableMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveEditableMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveEditableMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveEditableMethod "setEditable" o = EditableSetEditableMethodInfo
    ResolveEditableMethod "setEnableUndo" o = EditableSetEnableUndoMethodInfo
    ResolveEditableMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveEditableMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveEditableMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveEditableMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveEditableMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveEditableMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveEditableMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveEditableMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveEditableMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveEditableMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveEditableMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveEditableMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveEditableMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveEditableMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveEditableMethod "setMaxWidthChars" o = EditableSetMaxWidthCharsMethodInfo
    ResolveEditableMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveEditableMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveEditableMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveEditableMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveEditableMethod "setPosition" o = EditableSetPositionMethodInfo
    ResolveEditableMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveEditableMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveEditableMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveEditableMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveEditableMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveEditableMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveEditableMethod "setText" o = EditableSetTextMethodInfo
    ResolveEditableMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveEditableMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveEditableMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveEditableMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveEditableMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveEditableMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveEditableMethod "setWidthChars" o = EditableSetWidthCharsMethodInfo
    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::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 a
editable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> IO ()
gtk_editable_delete_selection Ptr Editable
editable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
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 a
editable Int32
startPos Int32
endPos = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> Int32 -> Int32 -> IO ()
gtk_editable_delete_text Ptr Editable
editable' Int32
startPos Int32
endPos
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
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::finish_delegate
-- 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_finish_delegate" gtk_editable_finish_delegate :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    IO ()

-- | Undoes the setup done by 'GI.Gtk.Interfaces.Editable.editableInitDelegate'.
-- 
-- This is a helper function that should be called from dispose,
-- before removing the delegate object.
editableFinishDelegate ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m ()
editableFinishDelegate :: a -> m ()
editableFinishDelegate a
editable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> IO ()
gtk_editable_finish_delegate Ptr Editable
editable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- method Editable::get_alignment
-- 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 TFloat)
-- throws : False
-- Skip return : False

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

-- | Gets the value set by 'GI.Gtk.Interfaces.Editable.editableSetAlignment'.
editableGetAlignment ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m Float
    -- ^ __Returns:__ the alignment
editableGetAlignment :: a -> m Float
editableGetAlignment a
editable = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
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
    CFloat
result <- Ptr Editable -> IO CFloat
gtk_editable_get_alignment Ptr Editable
editable'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

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

#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 a
editable Int32
startPos 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 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"editableGetChars" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
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 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
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
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_enable_undo
-- 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_enable_undo" gtk_editable_get_enable_undo :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    IO CInt

-- | Gets if undo\/redo actions are enabled for /@editable@/
editableGetEnableUndo ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if undo is enabled
editableGetEnableUndo :: a -> m Bool
editableGetEnableUndo 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_enable_undo Ptr Editable
editable'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Editable::get_max_width_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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

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

-- | Retrieves the desired maximum width of /@editable@/, in characters.
-- See 'GI.Gtk.Interfaces.Editable.editableSetMaxWidthChars'.
editableGetMaxWidthChars ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m Int32
    -- ^ __Returns:__ the maximum width of the entry, in characters
editableGetMaxWidthChars :: a -> m Int32
editableGetMaxWidthChars 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_max_width_chars Ptr Editable
editable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

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

#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 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 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
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.
-- 
-- /@startPos@/ 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 there is a non-empty selection, 'P.False' otherwise
editableGetSelectionBounds :: a -> m (Bool, Int32, Int32)
editableGetSelectionBounds 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
/= CInt
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 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
startPos
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
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::get_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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

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

-- | Retrieves the contents of /@editable@/. The returned string is
-- owned by GTK and must not be modified or freed.
editableGetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m T.Text
    -- ^ __Returns:__ a pointer to the contents of the editable.
editableGetText :: a -> m Text
editableGetText a
editable = 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 -> IO CString
gtk_editable_get_text Ptr Editable
editable'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"editableGetText" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

#endif

-- method Editable::get_width_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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

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

-- | Gets the value set by 'GI.Gtk.Interfaces.Editable.editableSetWidthChars'.
editableGetWidthChars ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m Int32
    -- ^ __Returns:__ number of chars to request space for, or negative if unset
editableGetWidthChars :: a -> m Int32
editableGetWidthChars 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_width_chars Ptr Editable
editable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

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

#endif

-- method Editable::init_delegate
-- 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_init_delegate" gtk_editable_init_delegate :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    IO ()

-- | Sets up a delegate for t'GI.Gtk.Interfaces.Editable.Editable', assuming that the
-- get_delegate vfunc in the t'GI.Gtk.Interfaces.Editable.Editable' interface has been
-- set up for the /@editable@/\'s type.
-- 
-- This is a helper function that should be called in instance init,
-- after creating the delegate object.
editableInitDelegate ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> m ()
editableInitDelegate :: a -> m ()
editableInitDelegate a
editable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> IO ()
gtk_editable_init_delegate Ptr Editable
editable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#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 = "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 = "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 ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- length : TBasicType TInt
    Ptr Int32 ->                            -- position : TBasicType TInt
    IO ()

-- | Inserts /@length@/ bytes of /@text@/ 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
    -- ^ /@text@/: the text to append
    -> Int32
    -- ^ /@length@/: 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 a
editable Text
text Int32
length_ 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
text' <- Text -> IO CString
textToCString Text
text
    Ptr Int32
position' <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int32
position' Int32
position
    Ptr Editable -> CString -> Int32 -> Ptr Int32 -> IO ()
gtk_editable_insert_text Ptr Editable
editable' CString
text' Int32
length_ Ptr Int32
position'
    Int32
position'' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
position'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
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::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 a
editable Int32
startPos Int32
endPos = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> Int32 -> Int32 -> IO ()
gtk_editable_select_region Ptr Editable
editable' Int32
startPos Int32
endPos
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
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_alignment
-- 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 = "xalign"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The horizontal alignment, from 0 (left) to 1 (right).\n         Reversed for RTL layouts"
--                 , 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_alignment" gtk_editable_set_alignment :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    CFloat ->                               -- xalign : TBasicType TFloat
    IO ()

-- | Sets the alignment for the contents of the editable.
-- 
-- This controls the horizontal positioning of the contents when
-- the displayed text is shorter than the width of the editable.
editableSetAlignment ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> Float
    -- ^ /@xalign@/: The horizontal alignment, from 0 (left) to 1 (right).
    --          Reversed for RTL layouts
    -> m ()
editableSetAlignment :: a -> Float -> m ()
editableSetAlignment a
editable Float
xalign = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    let xalign' :: CFloat
xalign' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign
    Ptr Editable -> CFloat -> IO ()
gtk_editable_set_alignment Ptr Editable
editable' CFloat
xalign'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EditableSetAlignmentMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsEditable a) => O.MethodInfo EditableSetAlignmentMethodInfo a signature where
    overloadedMethod = editableSetAlignment

#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 a
editable Bool
isEditable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 -> IO ()
gtk_editable_set_editable Ptr Editable
editable' CInt
isEditable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
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_enable_undo
-- 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 = "enable_undo"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if undo/redo should be enabled"
--                 , 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_enable_undo" gtk_editable_set_enable_undo :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    CInt ->                                 -- enable_undo : TBasicType TBoolean
    IO ()

-- | If enabled, changes to /@editable@/ will be saved for undo\/redo actions.
-- 
-- This results in an additional copy of text changes and are not stored in
-- secure memory. As such, undo is forcefully disabled when t'GI.Gtk.Objects.Text.Text':@/visibility/@
-- is set to 'P.False'.
editableSetEnableUndo ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> Bool
    -- ^ /@enableUndo@/: if undo\/redo should be enabled
    -> m ()
editableSetEnableUndo :: a -> Bool -> m ()
editableSetEnableUndo a
editable Bool
enableUndo = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    let enableUndo' :: CInt
enableUndo' = (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
enableUndo
    Ptr Editable -> CInt -> IO ()
gtk_editable_set_enable_undo Ptr Editable
editable' CInt
enableUndo'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- method Editable::set_max_width_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 = "n_chars"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new desired maximum width, in characters"
--                 , 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_max_width_chars" gtk_editable_set_max_width_chars :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    Int32 ->                                -- n_chars : TBasicType TInt
    IO ()

-- | Sets the desired maximum width in characters of /@editable@/.
editableSetMaxWidthChars ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> Int32
    -- ^ /@nChars@/: the new desired maximum width, in characters
    -> m ()
editableSetMaxWidthChars :: a -> Int32 -> m ()
editableSetMaxWidthChars a
editable Int32
nChars = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> Int32 -> IO ()
gtk_editable_set_max_width_chars Ptr Editable
editable' Int32
nChars
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#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 a
editable Int32
position = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> Int32 -> IO ()
gtk_editable_set_position Ptr Editable
editable' Int32
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
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

-- method Editable::set_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 = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the text to set" , 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_text" gtk_editable_set_text :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    CString ->                              -- text : TBasicType TUTF8
    IO ()

-- | Sets the text in the editable to the given value,
-- replacing the current contents.
editableSetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> T.Text
    -- ^ /@text@/: the text to set
    -> m ()
editableSetText :: a -> Text -> m ()
editableSetText a
editable Text
text = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr Editable -> CString -> IO ()
gtk_editable_set_text Ptr Editable
editable' CString
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- method Editable::set_width_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 = "n_chars"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "width in chars" , 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_width_chars" gtk_editable_set_width_chars :: 
    Ptr Editable ->                         -- editable : TInterface (Name {namespace = "Gtk", name = "Editable"})
    Int32 ->                                -- n_chars : TBasicType TInt
    IO ()

-- | Changes the size request of the editable to be about the
-- right size for /@nChars@/ characters.
-- 
-- Note that it changes the size request, the size can still
-- be affected by how you pack the widget into containers.
-- If /@nChars@/ is -1, the size reverts to the default size.
editableSetWidthChars ::
    (B.CallStack.HasCallStack, MonadIO m, IsEditable a) =>
    a
    -- ^ /@editable@/: a t'GI.Gtk.Interfaces.Editable.Editable'
    -> Int32
    -- ^ /@nChars@/: width in chars
    -> m ()
editableSetWidthChars :: a -> Int32 -> m ()
editableSetWidthChars a
editable Int32
nChars = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Editable
editable' <- a -> IO (Ptr Editable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
editable
    Ptr Editable -> Int32 -> IO ()
gtk_editable_set_width_chars Ptr Editable
editable' Int32
nChars
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
editable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- method Editable::delegate_get_property
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a property ID" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GParamSpec for the property"
--                 , 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_delegate_get_property" gtk_editable_delegate_get_property :: 
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    Word32 ->                               -- prop_id : TBasicType TUInt
    Ptr GValue ->                           -- value : TGValue
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    IO CInt

-- | Gets a property of the t'GI.Gtk.Interfaces.Editable.Editable' delegate for /@object@/.
-- 
-- This is helper function that should be called in get_property,
-- before handling your own properties.
editableDelegateGetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, GObject.Object.IsObject a) =>
    a
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object'
    -> Word32
    -- ^ /@propId@/: a property ID
    -> GValue
    -- ^ /@value@/: value to set
    -> GParamSpec
    -- ^ /@pspec@/: the t'GI.GObject.Objects.ParamSpec.ParamSpec' for the property
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the property was found
editableDelegateGetProperty :: a -> Word32 -> GValue -> GParamSpec -> m Bool
editableDelegateGetProperty a
object Word32
propId GValue
value GParamSpec
pspec = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    CInt
result <- Ptr Object -> Word32 -> Ptr GValue -> Ptr GParamSpec -> IO CInt
gtk_editable_delegate_get_property Ptr Object
object' Word32
propId Ptr GValue
value' Ptr GParamSpec
pspec'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
value'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Editable::delegate_set_property
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a property ID" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GParamSpec for the property"
--                 , 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_delegate_set_property" gtk_editable_delegate_set_property :: 
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    Word32 ->                               -- prop_id : TBasicType TUInt
    Ptr GValue ->                           -- value : TGValue
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    IO CInt

-- | Sets a property on the t'GI.Gtk.Interfaces.Editable.Editable' delegate for /@object@/.
-- 
-- This is a helper function that should be called in set_property,
-- before handling your own properties.
editableDelegateSetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, GObject.Object.IsObject a) =>
    a
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object'
    -> Word32
    -- ^ /@propId@/: a property ID
    -> GValue
    -- ^ /@value@/: value to set
    -> GParamSpec
    -- ^ /@pspec@/: the t'GI.GObject.Objects.ParamSpec.ParamSpec' for the property
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the property was found
editableDelegateSetProperty :: a -> Word32 -> GValue -> GParamSpec -> m Bool
editableDelegateSetProperty a
object Word32
propId GValue
value GParamSpec
pspec = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    CInt
result <- Ptr Object -> Word32 -> Ptr GValue -> Ptr GParamSpec -> IO CInt
gtk_editable_delegate_set_property Ptr Object
object' Word32
propId Ptr GValue
value' Ptr GParamSpec
pspec'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
value'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Editable::install_properties
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "object_class"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "ObjectClass" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GObjectClass" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "first_prop"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "property ID to use for the first property"
--                 , 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 "gtk_editable_install_properties" gtk_editable_install_properties :: 
    Ptr GObject.ObjectClass.ObjectClass ->  -- object_class : TInterface (Name {namespace = "GObject", name = "ObjectClass"})
    Word32 ->                               -- first_prop : TBasicType TUInt
    IO Word32

-- | Installs the GtkEditable properties for /@class@/.
-- 
-- This is a helper function that should be called in class_init,
-- after installing your own properties.
-- 
-- To handle the properties in your set_property and get_property
-- functions, you can either use 'GI.Gtk.Functions.editableDelegateSetProperty'
-- and 'GI.Gtk.Functions.editableDelegateGetProperty' (if you are using a delegate),
-- or remember the /@firstProp@/ offset and add it to the values in the
-- t'GI.Gtk.Enums.EditableProperties' enumeration to get the property IDs for these
-- properties.
editableInstallProperties ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GObject.ObjectClass.ObjectClass
    -- ^ /@objectClass@/: a t'GI.GObject.Structs.ObjectClass.ObjectClass'
    -> Word32
    -- ^ /@firstProp@/: property ID to use for the first property
    -> m Word32
    -- ^ __Returns:__ the number of properties that were installed
editableInstallProperties :: ObjectClass -> Word32 -> m Word32
editableInstallProperties ObjectClass
objectClass Word32
firstProp = IO Word32 -> m Word32
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 ObjectClass
objectClass' <- ObjectClass -> IO (Ptr ObjectClass)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ObjectClass
objectClass
    Word32
result <- Ptr ObjectClass -> Word32 -> IO Word32
gtk_editable_install_properties Ptr ObjectClass
objectClass' Word32
firstProp
    ObjectClass -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ObjectClass
objectClass
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
#endif

-- signal Editable::changed
-- | The [changed](#g: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](#g:signal:notify)[text](#g:signal:text) signals
-- to be emitted).
type EditableChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `EditableChangedCallback`@.
noEditableChangedCallback :: Maybe EditableChangedCallback
noEditableChangedCallback :: Maybe (IO ())
noEditableChangedCallback = Maybe (IO ())
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 :: IO () -> m (GClosure C_EditableChangedCallback)
genClosure_EditableChanged IO ()
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' = IO () -> C_EditableChangedCallback
wrap_EditableChangedCallback IO ()
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 :: IO () -> C_EditableChangedCallback
wrap_EditableChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' editable #changed callback
-- @
-- 
-- 
onEditableChanged :: (IsEditable a, MonadIO m) => a -> EditableChangedCallback -> m SignalHandlerId
onEditableChanged :: a -> IO () -> m SignalHandlerId
onEditableChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EditableChangedCallback
cb' = IO () -> C_EditableChangedCallback
wrap_EditableChangedCallback IO ()
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 Text
"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 -> IO () -> m SignalHandlerId
afterEditableChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EditableChangedCallback
cb' = IO () -> C_EditableChangedCallback
wrap_EditableChangedCallback IO ()
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 Text
"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 (Int32 -> Int32 -> IO ())
noEditableDeleteTextCallback = Maybe (Int32 -> Int32 -> IO ())
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 :: (Int32 -> Int32 -> IO ())
-> m (GClosure C_EditableDeleteTextCallback)
genClosure_EditableDeleteText Int32 -> Int32 -> IO ()
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' = (Int32 -> Int32 -> IO ()) -> C_EditableDeleteTextCallback
wrap_EditableDeleteTextCallback Int32 -> Int32 -> IO ()
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 :: (Int32 -> Int32 -> IO ()) -> C_EditableDeleteTextCallback
wrap_EditableDeleteTextCallback Int32 -> Int32 -> IO ()
_cb Ptr ()
_ Int32
startPos Int32
endPos Ptr ()
_ = do
    Int32 -> Int32 -> IO ()
_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 -> (Int32 -> Int32 -> IO ()) -> m SignalHandlerId
onEditableDeleteText a
obj Int32 -> Int32 -> IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EditableDeleteTextCallback
cb' = (Int32 -> Int32 -> IO ()) -> C_EditableDeleteTextCallback
wrap_EditableDeleteTextCallback Int32 -> Int32 -> IO ()
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 Text
"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 -> (Int32 -> Int32 -> IO ()) -> m SignalHandlerId
afterEditableDeleteText a
obj Int32 -> Int32 -> IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EditableDeleteTextCallback
cb' = (Int32 -> Int32 -> IO ()) -> C_EditableDeleteTextCallback
wrap_EditableDeleteTextCallback Int32 -> Int32 -> IO ()
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 Text
"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
    -- ^ /@text@/: the new text to insert
    -> Int32
    -- ^ /@length@/: 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 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 EditableInsertTextCallback
_cb Ptr ()
_ CString
text Int32
length_ Ptr Int32
position Ptr ()
_ = do
    Text
text' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
text
    Int32
position' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
position
    Int32
outposition <- EditableInsertTextCallback
_cb  Text
text' Int32
length_ Int32
position'
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
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 a
obj 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 Text
"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 a
obj 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 Text
"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), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("insertText", EditableInsertTextSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif