{-# 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.Objects.Text.Text' widget is a single line text entry widget.
-- 
-- A fairly large set of key bindings are supported by default. If the
-- entered text is longer than the allocation of the widget, the widget
-- will scroll so that the cursor position is visible.
-- 
-- When using an entry for passwords and other sensitive information,
-- it can be put into “password mode” using 'GI.Gtk.Objects.Text.textSetVisibility'.
-- In this mode, entered text is displayed using a “invisible” character.
-- By default, GTK picks the best invisible character that is available
-- in the current font, but it can be changed with 'GI.Gtk.Objects.Text.textSetInvisibleChar'.
-- 
-- If you are looking to add icons or progress display in an entry, look
-- at t'GI.Gtk.Objects.Entry.Entry'. There other alternatives for more specialized use cases,
-- such as t'GI.Gtk.Objects.SearchEntry.SearchEntry'.
-- 
-- If you need multi-line editable text, look at t'GI.Gtk.Objects.TextView.TextView'.
-- 
-- = CSS nodes
-- 
-- 
-- === /plain code/
-- >
-- >text[.read-only]
-- >├── placeholder
-- >├── undershoot.left
-- >├── undershoot.right
-- >├── [selection]
-- >├── [block-cursor]
-- >╰── [window.popup]
-- 
-- 
-- GtkText has a main node with the name text. Depending on the properties
-- of the widget, the .read-only style class may appear.
-- 
-- When the entry has a selection, it adds a subnode with the name selection.
-- 
-- When the entry is in overwrite mode, it adds a subnode with the name block-cursor
-- that determines how the block cursor is drawn.
-- 
-- The CSS node for a context menu is added as a subnode below text as well.
-- 
-- The undershoot nodes are used to draw the underflow indication when content
-- is scrolled out of view. These nodes get the .left and .right style classes
-- added depending on where the indication is drawn.
-- 
-- When touch is used and touch selection handles are shown, they are using
-- CSS nodes with name cursor-handle. They get the .top or .bottom style class
-- depending on where they are shown in relation to the selection. If there is
-- just a single handle for the text cursor, it gets the style class .insertion-cursor.

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

module GI.Gtk.Objects.Text
    ( 

-- * Exported types
    Text(..)                                ,
    IsText                                  ,
    toText                                  ,
    noText                                  ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTextMethod                       ,
#endif


-- ** getActivatesDefault #method:getActivatesDefault#

#if defined(ENABLE_OVERLOADING)
    TextGetActivatesDefaultMethodInfo       ,
#endif
    textGetActivatesDefault                 ,


-- ** getAttributes #method:getAttributes#

#if defined(ENABLE_OVERLOADING)
    TextGetAttributesMethodInfo             ,
#endif
    textGetAttributes                       ,


-- ** getBuffer #method:getBuffer#

#if defined(ENABLE_OVERLOADING)
    TextGetBufferMethodInfo                 ,
#endif
    textGetBuffer                           ,


-- ** getInputHints #method:getInputHints#

#if defined(ENABLE_OVERLOADING)
    TextGetInputHintsMethodInfo             ,
#endif
    textGetInputHints                       ,


-- ** getInputPurpose #method:getInputPurpose#

#if defined(ENABLE_OVERLOADING)
    TextGetInputPurposeMethodInfo           ,
#endif
    textGetInputPurpose                     ,


-- ** getInvisibleChar #method:getInvisibleChar#

#if defined(ENABLE_OVERLOADING)
    TextGetInvisibleCharMethodInfo          ,
#endif
    textGetInvisibleChar                    ,


-- ** getMaxLength #method:getMaxLength#

#if defined(ENABLE_OVERLOADING)
    TextGetMaxLengthMethodInfo              ,
#endif
    textGetMaxLength                        ,


-- ** getOverwriteMode #method:getOverwriteMode#

#if defined(ENABLE_OVERLOADING)
    TextGetOverwriteModeMethodInfo          ,
#endif
    textGetOverwriteMode                    ,


-- ** getPlaceholderText #method:getPlaceholderText#

#if defined(ENABLE_OVERLOADING)
    TextGetPlaceholderTextMethodInfo        ,
#endif
    textGetPlaceholderText                  ,


-- ** getTabs #method:getTabs#

#if defined(ENABLE_OVERLOADING)
    TextGetTabsMethodInfo                   ,
#endif
    textGetTabs                             ,


-- ** getTextLength #method:getTextLength#

#if defined(ENABLE_OVERLOADING)
    TextGetTextLengthMethodInfo             ,
#endif
    textGetTextLength                       ,


-- ** getVisibility #method:getVisibility#

#if defined(ENABLE_OVERLOADING)
    TextGetVisibilityMethodInfo             ,
#endif
    textGetVisibility                       ,


-- ** grabFocusWithoutSelecting #method:grabFocusWithoutSelecting#

#if defined(ENABLE_OVERLOADING)
    TextGrabFocusWithoutSelectingMethodInfo ,
#endif
    textGrabFocusWithoutSelecting           ,


-- ** new #method:new#

    textNew                                 ,


-- ** newWithBuffer #method:newWithBuffer#

    textNewWithBuffer                       ,


-- ** setActivatesDefault #method:setActivatesDefault#

#if defined(ENABLE_OVERLOADING)
    TextSetActivatesDefaultMethodInfo       ,
#endif
    textSetActivatesDefault                 ,


-- ** setAttributes #method:setAttributes#

#if defined(ENABLE_OVERLOADING)
    TextSetAttributesMethodInfo             ,
#endif
    textSetAttributes                       ,


-- ** setBuffer #method:setBuffer#

#if defined(ENABLE_OVERLOADING)
    TextSetBufferMethodInfo                 ,
#endif
    textSetBuffer                           ,


-- ** setInputHints #method:setInputHints#

#if defined(ENABLE_OVERLOADING)
    TextSetInputHintsMethodInfo             ,
#endif
    textSetInputHints                       ,


-- ** setInputPurpose #method:setInputPurpose#

#if defined(ENABLE_OVERLOADING)
    TextSetInputPurposeMethodInfo           ,
#endif
    textSetInputPurpose                     ,


-- ** setInvisibleChar #method:setInvisibleChar#

#if defined(ENABLE_OVERLOADING)
    TextSetInvisibleCharMethodInfo          ,
#endif
    textSetInvisibleChar                    ,


-- ** setMaxLength #method:setMaxLength#

#if defined(ENABLE_OVERLOADING)
    TextSetMaxLengthMethodInfo              ,
#endif
    textSetMaxLength                        ,


-- ** setOverwriteMode #method:setOverwriteMode#

#if defined(ENABLE_OVERLOADING)
    TextSetOverwriteModeMethodInfo          ,
#endif
    textSetOverwriteMode                    ,


-- ** setPlaceholderText #method:setPlaceholderText#

#if defined(ENABLE_OVERLOADING)
    TextSetPlaceholderTextMethodInfo        ,
#endif
    textSetPlaceholderText                  ,


-- ** setTabs #method:setTabs#

#if defined(ENABLE_OVERLOADING)
    TextSetTabsMethodInfo                   ,
#endif
    textSetTabs                             ,


-- ** setVisibility #method:setVisibility#

#if defined(ENABLE_OVERLOADING)
    TextSetVisibilityMethodInfo             ,
#endif
    textSetVisibility                       ,


-- ** unsetInvisibleChar #method:unsetInvisibleChar#

#if defined(ENABLE_OVERLOADING)
    TextUnsetInvisibleCharMethodInfo        ,
#endif
    textUnsetInvisibleChar                  ,




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

#if defined(ENABLE_OVERLOADING)
    TextActivatesDefaultPropertyInfo        ,
#endif
    constructTextActivatesDefault           ,
    getTextActivatesDefault                 ,
    setTextActivatesDefault                 ,
#if defined(ENABLE_OVERLOADING)
    textActivatesDefault                    ,
#endif


-- ** attributes #attr:attributes#
-- | A list of Pango attributes to apply to the text of the self.
-- 
-- This is mainly useful to change the size or weight of the text.
-- 
-- The t'GI.Pango.Structs.Attribute.Attribute'\'s /@startIndex@/ and /@endIndex@/ must refer to the
-- t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' text, i.e. without the preedit string.

#if defined(ENABLE_OVERLOADING)
    TextAttributesPropertyInfo              ,
#endif
    constructTextAttributes                 ,
    getTextAttributes                       ,
    setTextAttributes                       ,
#if defined(ENABLE_OVERLOADING)
    textAttributes                          ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TextBufferPropertyInfo                  ,
#endif
    constructTextBuffer                     ,
    getTextBuffer                           ,
    setTextBuffer                           ,
#if defined(ENABLE_OVERLOADING)
    textBuffer                              ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TextEnableEmojiCompletionPropertyInfo   ,
#endif
    constructTextEnableEmojiCompletion      ,
    getTextEnableEmojiCompletion            ,
    setTextEnableEmojiCompletion            ,
#if defined(ENABLE_OVERLOADING)
    textEnableEmojiCompletion               ,
#endif


-- ** imModule #attr:imModule#
-- | Which IM (input method) module should be used for this self.
-- See t'GI.Gtk.Objects.IMContext.IMContext'.
-- 
-- Setting this to a non-'P.Nothing' value overrides the
-- system-wide IM module setting. See the GtkSettings
-- t'GI.Gtk.Objects.Settings.Settings':@/gtk-im-module/@ property.

#if defined(ENABLE_OVERLOADING)
    TextImModulePropertyInfo                ,
#endif
    clearTextImModule                       ,
    constructTextImModule                   ,
    getTextImModule                         ,
    setTextImModule                         ,
#if defined(ENABLE_OVERLOADING)
    textImModule                            ,
#endif


-- ** inputHints #attr:inputHints#
-- | Additional hints (beyond t'GI.Gtk.Objects.Text.Text':@/input-purpose/@) that
-- allow input methods to fine-tune their behaviour.

#if defined(ENABLE_OVERLOADING)
    TextInputHintsPropertyInfo              ,
#endif
    constructTextInputHints                 ,
    getTextInputHints                       ,
    setTextInputHints                       ,
#if defined(ENABLE_OVERLOADING)
    textInputHints                          ,
#endif


-- ** inputPurpose #attr:inputPurpose#
-- | The purpose of this text field.
-- 
-- This property can be used by on-screen keyboards and other input
-- methods to adjust their behaviour.
-- 
-- Note that setting the purpose to 'GI.Gtk.Enums.InputPurposePassword' or
-- 'GI.Gtk.Enums.InputPurposePin' is independent from setting
-- t'GI.Gtk.Objects.Text.Text':@/visibility/@.

#if defined(ENABLE_OVERLOADING)
    TextInputPurposePropertyInfo            ,
#endif
    constructTextInputPurpose               ,
    getTextInputPurpose                     ,
    setTextInputPurpose                     ,
#if defined(ENABLE_OVERLOADING)
    textInputPurpose                        ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TextInvisibleCharPropertyInfo           ,
#endif
    constructTextInvisibleChar              ,
    getTextInvisibleChar                    ,
    setTextInvisibleChar                    ,
#if defined(ENABLE_OVERLOADING)
    textInvisibleChar                       ,
#endif


-- ** invisibleCharSet #attr:invisibleCharSet#
-- | Whether the invisible char has been set for the t'GI.Gtk.Objects.Text.Text'.

#if defined(ENABLE_OVERLOADING)
    TextInvisibleCharSetPropertyInfo        ,
#endif
    constructTextInvisibleCharSet           ,
    getTextInvisibleCharSet                 ,
    setTextInvisibleCharSet                 ,
#if defined(ENABLE_OVERLOADING)
    textInvisibleCharSet                    ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TextMaxLengthPropertyInfo               ,
#endif
    constructTextMaxLength                  ,
    getTextMaxLength                        ,
    setTextMaxLength                        ,
#if defined(ENABLE_OVERLOADING)
    textMaxLength                           ,
#endif


-- ** overwriteMode #attr:overwriteMode#
-- | If text is overwritten when typing in the t'GI.Gtk.Objects.Text.Text'.

#if defined(ENABLE_OVERLOADING)
    TextOverwriteModePropertyInfo           ,
#endif
    constructTextOverwriteMode              ,
    getTextOverwriteMode                    ,
    setTextOverwriteMode                    ,
#if defined(ENABLE_OVERLOADING)
    textOverwriteMode                       ,
#endif


-- ** placeholderText #attr:placeholderText#
-- | The text that will be displayed in the t'GI.Gtk.Objects.Text.Text' when it is empty
-- and unfocused.

#if defined(ENABLE_OVERLOADING)
    TextPlaceholderTextPropertyInfo         ,
#endif
    clearTextPlaceholderText                ,
    constructTextPlaceholderText            ,
    getTextPlaceholderText                  ,
    setTextPlaceholderText                  ,
#if defined(ENABLE_OVERLOADING)
    textPlaceholderText                     ,
#endif


-- ** populateAll #attr:populateAll#
-- | If :populate-all is 'P.True', the [populatePopup]("GI.Gtk.Objects.Text#signal:populatePopup")
-- signal is also emitted for touch popups.

#if defined(ENABLE_OVERLOADING)
    TextPopulateAllPropertyInfo             ,
#endif
    constructTextPopulateAll                ,
    getTextPopulateAll                      ,
    setTextPopulateAll                      ,
#if defined(ENABLE_OVERLOADING)
    textPopulateAll                         ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TextPropagateTextWidthPropertyInfo      ,
#endif
    constructTextPropagateTextWidth         ,
    getTextPropagateTextWidth               ,
    setTextPropagateTextWidth               ,
#if defined(ENABLE_OVERLOADING)
    textPropagateTextWidth                  ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TextScrollOffsetPropertyInfo            ,
#endif
    getTextScrollOffset                     ,
#if defined(ENABLE_OVERLOADING)
    textScrollOffset                        ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TextTabsPropertyInfo                    ,
#endif
    clearTextTabs                           ,
    constructTextTabs                       ,
    getTextTabs                             ,
    setTextTabs                             ,
#if defined(ENABLE_OVERLOADING)
    textTabs                                ,
#endif


-- ** truncateMultiline #attr:truncateMultiline#
-- | When 'P.True', pasted multi-line text is truncated to the first line.

#if defined(ENABLE_OVERLOADING)
    TextTruncateMultilinePropertyInfo       ,
#endif
    constructTextTruncateMultiline          ,
    getTextTruncateMultiline                ,
    setTextTruncateMultiline                ,
#if defined(ENABLE_OVERLOADING)
    textTruncateMultiline                   ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TextVisibilityPropertyInfo              ,
#endif
    constructTextVisibility                 ,
    getTextVisibility                       ,
    setTextVisibility                       ,
#if defined(ENABLE_OVERLOADING)
    textVisibility                          ,
#endif




 -- * Signals
-- ** activate #signal:activate#

    C_TextActivateCallback                  ,
    TextActivateCallback                    ,
#if defined(ENABLE_OVERLOADING)
    TextActivateSignalInfo                  ,
#endif
    afterTextActivate                       ,
    genClosure_TextActivate                 ,
    mk_TextActivateCallback                 ,
    noTextActivateCallback                  ,
    onTextActivate                          ,
    wrap_TextActivateCallback               ,


-- ** backspace #signal:backspace#

    C_TextBackspaceCallback                 ,
    TextBackspaceCallback                   ,
#if defined(ENABLE_OVERLOADING)
    TextBackspaceSignalInfo                 ,
#endif
    afterTextBackspace                      ,
    genClosure_TextBackspace                ,
    mk_TextBackspaceCallback                ,
    noTextBackspaceCallback                 ,
    onTextBackspace                         ,
    wrap_TextBackspaceCallback              ,


-- ** copyClipboard #signal:copyClipboard#

    C_TextCopyClipboardCallback             ,
    TextCopyClipboardCallback               ,
#if defined(ENABLE_OVERLOADING)
    TextCopyClipboardSignalInfo             ,
#endif
    afterTextCopyClipboard                  ,
    genClosure_TextCopyClipboard            ,
    mk_TextCopyClipboardCallback            ,
    noTextCopyClipboardCallback             ,
    onTextCopyClipboard                     ,
    wrap_TextCopyClipboardCallback          ,


-- ** cutClipboard #signal:cutClipboard#

    C_TextCutClipboardCallback              ,
    TextCutClipboardCallback                ,
#if defined(ENABLE_OVERLOADING)
    TextCutClipboardSignalInfo              ,
#endif
    afterTextCutClipboard                   ,
    genClosure_TextCutClipboard             ,
    mk_TextCutClipboardCallback             ,
    noTextCutClipboardCallback              ,
    onTextCutClipboard                      ,
    wrap_TextCutClipboardCallback           ,


-- ** deleteFromCursor #signal:deleteFromCursor#

    C_TextDeleteFromCursorCallback          ,
    TextDeleteFromCursorCallback            ,
#if defined(ENABLE_OVERLOADING)
    TextDeleteFromCursorSignalInfo          ,
#endif
    afterTextDeleteFromCursor               ,
    genClosure_TextDeleteFromCursor         ,
    mk_TextDeleteFromCursorCallback         ,
    noTextDeleteFromCursorCallback          ,
    onTextDeleteFromCursor                  ,
    wrap_TextDeleteFromCursorCallback       ,


-- ** insertAtCursor #signal:insertAtCursor#

    C_TextInsertAtCursorCallback            ,
    TextInsertAtCursorCallback              ,
#if defined(ENABLE_OVERLOADING)
    TextInsertAtCursorSignalInfo            ,
#endif
    afterTextInsertAtCursor                 ,
    genClosure_TextInsertAtCursor           ,
    mk_TextInsertAtCursorCallback           ,
    noTextInsertAtCursorCallback            ,
    onTextInsertAtCursor                    ,
    wrap_TextInsertAtCursorCallback         ,


-- ** insertEmoji #signal:insertEmoji#

    C_TextInsertEmojiCallback               ,
    TextInsertEmojiCallback                 ,
#if defined(ENABLE_OVERLOADING)
    TextInsertEmojiSignalInfo               ,
#endif
    afterTextInsertEmoji                    ,
    genClosure_TextInsertEmoji              ,
    mk_TextInsertEmojiCallback              ,
    noTextInsertEmojiCallback               ,
    onTextInsertEmoji                       ,
    wrap_TextInsertEmojiCallback            ,


-- ** moveCursor #signal:moveCursor#

    C_TextMoveCursorCallback                ,
    TextMoveCursorCallback                  ,
#if defined(ENABLE_OVERLOADING)
    TextMoveCursorSignalInfo                ,
#endif
    afterTextMoveCursor                     ,
    genClosure_TextMoveCursor               ,
    mk_TextMoveCursorCallback               ,
    noTextMoveCursorCallback                ,
    onTextMoveCursor                        ,
    wrap_TextMoveCursorCallback             ,


-- ** pasteClipboard #signal:pasteClipboard#

    C_TextPasteClipboardCallback            ,
    TextPasteClipboardCallback              ,
#if defined(ENABLE_OVERLOADING)
    TextPasteClipboardSignalInfo            ,
#endif
    afterTextPasteClipboard                 ,
    genClosure_TextPasteClipboard           ,
    mk_TextPasteClipboardCallback           ,
    noTextPasteClipboardCallback            ,
    onTextPasteClipboard                    ,
    wrap_TextPasteClipboardCallback         ,


-- ** populatePopup #signal:populatePopup#

    C_TextPopulatePopupCallback             ,
    TextPopulatePopupCallback               ,
#if defined(ENABLE_OVERLOADING)
    TextPopulatePopupSignalInfo             ,
#endif
    afterTextPopulatePopup                  ,
    genClosure_TextPopulatePopup            ,
    mk_TextPopulatePopupCallback            ,
    noTextPopulatePopupCallback             ,
    onTextPopulatePopup                     ,
    wrap_TextPopulatePopupCallback          ,


-- ** preeditChanged #signal:preeditChanged#

    C_TextPreeditChangedCallback            ,
    TextPreeditChangedCallback              ,
#if defined(ENABLE_OVERLOADING)
    TextPreeditChangedSignalInfo            ,
#endif
    afterTextPreeditChanged                 ,
    genClosure_TextPreeditChanged           ,
    mk_TextPreeditChangedCallback           ,
    noTextPreeditChangedCallback            ,
    onTextPreeditChanged                    ,
    wrap_TextPreeditChangedCallback         ,


-- ** toggleOverwrite #signal:toggleOverwrite#

    C_TextToggleOverwriteCallback           ,
    TextToggleOverwriteCallback             ,
#if defined(ENABLE_OVERLOADING)
    TextToggleOverwriteSignalInfo           ,
#endif
    afterTextToggleOverwrite                ,
    genClosure_TextToggleOverwrite          ,
    mk_TextToggleOverwriteCallback          ,
    noTextToggleOverwriteCallback           ,
    onTextToggleOverwrite                   ,
    wrap_TextToggleOverwriteCallback        ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Editable as Gtk.Editable
import {-# SOURCE #-} qualified GI.Gtk.Objects.EntryBuffer as Gtk.EntryBuffer
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import qualified GI.Pango.Structs.AttrList as Pango.AttrList
import qualified GI.Pango.Structs.TabArray as Pango.TabArray

-- | Memory-managed wrapper type.
newtype Text = Text (ManagedPtr Text)
    deriving (Text -> Text -> Bool
(Text -> Text -> Bool) -> (Text -> Text -> Bool) -> Eq Text
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Text -> Text -> Bool
$c/= :: Text -> Text -> Bool
== :: Text -> Text -> Bool
$c== :: Text -> Text -> Bool
Eq)
foreign import ccall "gtk_text_get_type"
    c_gtk_text_get_type :: IO GType

instance GObject Text where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_text_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `Text`.
noText :: Maybe Text
noText :: Maybe Text
noText = Maybe Text
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveTextMethod (t :: Symbol) (o :: *) :: * where
    ResolveTextMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveTextMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveTextMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveTextMethod "addAccelerator" o = Gtk.Widget.WidgetAddAcceleratorMethodInfo
    ResolveTextMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveTextMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveTextMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveTextMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveTextMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveTextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTextMethod "canActivateAccel" o = Gtk.Widget.WidgetCanActivateAccelMethodInfo
    ResolveTextMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveTextMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveTextMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveTextMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveTextMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveTextMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveTextMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveTextMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveTextMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveTextMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveTextMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveTextMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveTextMethod "deleteSelection" o = Gtk.Editable.EditableDeleteSelectionMethodInfo
    ResolveTextMethod "deleteText" o = Gtk.Editable.EditableDeleteTextMethodInfo
    ResolveTextMethod "destroy" o = Gtk.Widget.WidgetDestroyMethodInfo
    ResolveTextMethod "destroyed" o = Gtk.Widget.WidgetDestroyedMethodInfo
    ResolveTextMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveTextMethod "dragBegin" o = Gtk.Widget.WidgetDragBeginMethodInfo
    ResolveTextMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveTextMethod "dragDestAddImageTargets" o = Gtk.Widget.WidgetDragDestAddImageTargetsMethodInfo
    ResolveTextMethod "dragDestAddTextTargets" o = Gtk.Widget.WidgetDragDestAddTextTargetsMethodInfo
    ResolveTextMethod "dragDestAddUriTargets" o = Gtk.Widget.WidgetDragDestAddUriTargetsMethodInfo
    ResolveTextMethod "dragDestFindTarget" o = Gtk.Widget.WidgetDragDestFindTargetMethodInfo
    ResolveTextMethod "dragDestGetTargetList" o = Gtk.Widget.WidgetDragDestGetTargetListMethodInfo
    ResolveTextMethod "dragDestGetTrackMotion" o = Gtk.Widget.WidgetDragDestGetTrackMotionMethodInfo
    ResolveTextMethod "dragDestSet" o = Gtk.Widget.WidgetDragDestSetMethodInfo
    ResolveTextMethod "dragDestSetTargetList" o = Gtk.Widget.WidgetDragDestSetTargetListMethodInfo
    ResolveTextMethod "dragDestSetTrackMotion" o = Gtk.Widget.WidgetDragDestSetTrackMotionMethodInfo
    ResolveTextMethod "dragDestUnset" o = Gtk.Widget.WidgetDragDestUnsetMethodInfo
    ResolveTextMethod "dragGetData" o = Gtk.Widget.WidgetDragGetDataMethodInfo
    ResolveTextMethod "dragHighlight" o = Gtk.Widget.WidgetDragHighlightMethodInfo
    ResolveTextMethod "dragSourceAddImageTargets" o = Gtk.Widget.WidgetDragSourceAddImageTargetsMethodInfo
    ResolveTextMethod "dragSourceAddTextTargets" o = Gtk.Widget.WidgetDragSourceAddTextTargetsMethodInfo
    ResolveTextMethod "dragSourceAddUriTargets" o = Gtk.Widget.WidgetDragSourceAddUriTargetsMethodInfo
    ResolveTextMethod "dragSourceGetTargetList" o = Gtk.Widget.WidgetDragSourceGetTargetListMethodInfo
    ResolveTextMethod "dragSourceSet" o = Gtk.Widget.WidgetDragSourceSetMethodInfo
    ResolveTextMethod "dragSourceSetIconGicon" o = Gtk.Widget.WidgetDragSourceSetIconGiconMethodInfo
    ResolveTextMethod "dragSourceSetIconName" o = Gtk.Widget.WidgetDragSourceSetIconNameMethodInfo
    ResolveTextMethod "dragSourceSetIconPaintable" o = Gtk.Widget.WidgetDragSourceSetIconPaintableMethodInfo
    ResolveTextMethod "dragSourceSetTargetList" o = Gtk.Widget.WidgetDragSourceSetTargetListMethodInfo
    ResolveTextMethod "dragSourceUnset" o = Gtk.Widget.WidgetDragSourceUnsetMethodInfo
    ResolveTextMethod "dragUnhighlight" o = Gtk.Widget.WidgetDragUnhighlightMethodInfo
    ResolveTextMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveTextMethod "event" o = Gtk.Widget.WidgetEventMethodInfo
    ResolveTextMethod "finishDelegate" o = Gtk.Editable.EditableFinishDelegateMethodInfo
    ResolveTextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTextMethod "grabAdd" o = Gtk.Widget.WidgetGrabAddMethodInfo
    ResolveTextMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveTextMethod "grabFocusWithoutSelecting" o = TextGrabFocusWithoutSelectingMethodInfo
    ResolveTextMethod "grabRemove" o = Gtk.Widget.WidgetGrabRemoveMethodInfo
    ResolveTextMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveTextMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveTextMethod "hasGrab" o = Gtk.Widget.WidgetHasGrabMethodInfo
    ResolveTextMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveTextMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveTextMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveTextMethod "initDelegate" o = Gtk.Editable.EditableInitDelegateMethodInfo
    ResolveTextMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveTextMethod "inputShapeCombineRegion" o = Gtk.Widget.WidgetInputShapeCombineRegionMethodInfo
    ResolveTextMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveTextMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveTextMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveTextMethod "insertText" o = Gtk.Editable.EditableInsertTextMethodInfo
    ResolveTextMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveTextMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveTextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTextMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveTextMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveTextMethod "isToplevel" o = Gtk.Widget.WidgetIsToplevelMethodInfo
    ResolveTextMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveTextMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveTextMethod "listAccelClosures" o = Gtk.Widget.WidgetListAccelClosuresMethodInfo
    ResolveTextMethod "listActionPrefixes" o = Gtk.Widget.WidgetListActionPrefixesMethodInfo
    ResolveTextMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveTextMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveTextMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveTextMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveTextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTextMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveTextMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveTextMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveTextMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveTextMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveTextMethod "queueComputeExpand" o = Gtk.Widget.WidgetQueueComputeExpandMethodInfo
    ResolveTextMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveTextMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveTextMethod "queueResizeNoRedraw" o = Gtk.Widget.WidgetQueueResizeNoRedrawMethodInfo
    ResolveTextMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveTextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTextMethod "registerSurface" o = Gtk.Widget.WidgetRegisterSurfaceMethodInfo
    ResolveTextMethod "removeAccelerator" o = Gtk.Widget.WidgetRemoveAcceleratorMethodInfo
    ResolveTextMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveTextMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveTextMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveTextMethod "resetStyle" o = Gtk.Widget.WidgetResetStyleMethodInfo
    ResolveTextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTextMethod "selectRegion" o = Gtk.Editable.EditableSelectRegionMethodInfo
    ResolveTextMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveTextMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveTextMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveTextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTextMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveTextMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveTextMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveTextMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveTextMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveTextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTextMethod "unregisterSurface" o = Gtk.Widget.WidgetUnregisterSurfaceMethodInfo
    ResolveTextMethod "unsetInvisibleChar" o = TextUnsetInvisibleCharMethodInfo
    ResolveTextMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveTextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTextMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveTextMethod "getActionGroup" o = Gtk.Widget.WidgetGetActionGroupMethodInfo
    ResolveTextMethod "getActivatesDefault" o = TextGetActivatesDefaultMethodInfo
    ResolveTextMethod "getAlignment" o = Gtk.Editable.EditableGetAlignmentMethodInfo
    ResolveTextMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveTextMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveTextMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveTextMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveTextMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveTextMethod "getAttributes" o = TextGetAttributesMethodInfo
    ResolveTextMethod "getBuffer" o = TextGetBufferMethodInfo
    ResolveTextMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveTextMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveTextMethod "getChars" o = Gtk.Editable.EditableGetCharsMethodInfo
    ResolveTextMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveTextMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveTextMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveTextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTextMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveTextMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveTextMethod "getEditable" o = Gtk.Editable.EditableGetEditableMethodInfo
    ResolveTextMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveTextMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveTextMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveTextMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveTextMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveTextMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveTextMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveTextMethod "getHasSurface" o = Gtk.Widget.WidgetGetHasSurfaceMethodInfo
    ResolveTextMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveTextMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveTextMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveTextMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveTextMethod "getInputHints" o = TextGetInputHintsMethodInfo
    ResolveTextMethod "getInputPurpose" o = TextGetInputPurposeMethodInfo
    ResolveTextMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveTextMethod "getInvisibleChar" o = TextGetInvisibleCharMethodInfo
    ResolveTextMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveTextMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveTextMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveTextMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveTextMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveTextMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveTextMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveTextMethod "getMaxLength" o = TextGetMaxLengthMethodInfo
    ResolveTextMethod "getMaxWidthChars" o = Gtk.Editable.EditableGetMaxWidthCharsMethodInfo
    ResolveTextMethod "getModifierMask" o = Gtk.Widget.WidgetGetModifierMaskMethodInfo
    ResolveTextMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveTextMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveTextMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveTextMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveTextMethod "getOverwriteMode" o = TextGetOverwriteModeMethodInfo
    ResolveTextMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveTextMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveTextMethod "getPath" o = Gtk.Widget.WidgetGetPathMethodInfo
    ResolveTextMethod "getPlaceholderText" o = TextGetPlaceholderTextMethodInfo
    ResolveTextMethod "getPosition" o = Gtk.Editable.EditableGetPositionMethodInfo
    ResolveTextMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveTextMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveTextMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveTextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTextMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveTextMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveTextMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveTextMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveTextMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveTextMethod "getSelectionBounds" o = Gtk.Editable.EditableGetSelectionBoundsMethodInfo
    ResolveTextMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveTextMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveTextMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveTextMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveTextMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveTextMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveTextMethod "getSurface" o = Gtk.Widget.WidgetGetSurfaceMethodInfo
    ResolveTextMethod "getTabs" o = TextGetTabsMethodInfo
    ResolveTextMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveTextMethod "getText" o = Gtk.Editable.EditableGetTextMethodInfo
    ResolveTextMethod "getTextLength" o = TextGetTextLengthMethodInfo
    ResolveTextMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveTextMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveTextMethod "getTooltipWindow" o = Gtk.Widget.WidgetGetTooltipWindowMethodInfo
    ResolveTextMethod "getToplevel" o = Gtk.Widget.WidgetGetToplevelMethodInfo
    ResolveTextMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveTextMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveTextMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveTextMethod "getVisibility" o = TextGetVisibilityMethodInfo
    ResolveTextMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveTextMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveTextMethod "getWidthChars" o = Gtk.Editable.EditableGetWidthCharsMethodInfo
    ResolveTextMethod "setAccelPath" o = Gtk.Widget.WidgetSetAccelPathMethodInfo
    ResolveTextMethod "setActivatesDefault" o = TextSetActivatesDefaultMethodInfo
    ResolveTextMethod "setAlignment" o = Gtk.Editable.EditableSetAlignmentMethodInfo
    ResolveTextMethod "setAttributes" o = TextSetAttributesMethodInfo
    ResolveTextMethod "setBuffer" o = TextSetBufferMethodInfo
    ResolveTextMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveTextMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveTextMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveTextMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveTextMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveTextMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveTextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTextMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveTextMethod "setEditable" o = Gtk.Editable.EditableSetEditableMethodInfo
    ResolveTextMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveTextMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveTextMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveTextMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveTextMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveTextMethod "setHasSurface" o = Gtk.Widget.WidgetSetHasSurfaceMethodInfo
    ResolveTextMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveTextMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveTextMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveTextMethod "setInputHints" o = TextSetInputHintsMethodInfo
    ResolveTextMethod "setInputPurpose" o = TextSetInputPurposeMethodInfo
    ResolveTextMethod "setInvisibleChar" o = TextSetInvisibleCharMethodInfo
    ResolveTextMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveTextMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveTextMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveTextMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveTextMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveTextMethod "setMaxLength" o = TextSetMaxLengthMethodInfo
    ResolveTextMethod "setMaxWidthChars" o = Gtk.Editable.EditableSetMaxWidthCharsMethodInfo
    ResolveTextMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveTextMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveTextMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveTextMethod "setOverwriteMode" o = TextSetOverwriteModeMethodInfo
    ResolveTextMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveTextMethod "setPlaceholderText" o = TextSetPlaceholderTextMethodInfo
    ResolveTextMethod "setPosition" o = Gtk.Editable.EditableSetPositionMethodInfo
    ResolveTextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTextMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveTextMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveTextMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveTextMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveTextMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveTextMethod "setSurface" o = Gtk.Widget.WidgetSetSurfaceMethodInfo
    ResolveTextMethod "setTabs" o = TextSetTabsMethodInfo
    ResolveTextMethod "setText" o = Gtk.Editable.EditableSetTextMethodInfo
    ResolveTextMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveTextMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveTextMethod "setTooltipWindow" o = Gtk.Widget.WidgetSetTooltipWindowMethodInfo
    ResolveTextMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveTextMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveTextMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveTextMethod "setVisibility" o = TextSetVisibilityMethodInfo
    ResolveTextMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveTextMethod "setWidthChars" o = Gtk.Editable.EditableSetWidthCharsMethodInfo
    ResolveTextMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Text::activate
-- | The [activate](#signal:activate) signal is emitted when the user hits
-- the Enter key.
-- 
-- The default bindings for this signal are all forms of the Enter key.
type TextActivateCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextActivate :: MonadIO m => TextActivateCallback -> m (GClosure C_TextActivateCallback)
genClosure_TextActivate :: IO () -> m (GClosure C_TextActivateCallback)
genClosure_TextActivate cb :: IO ()
cb = IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextActivateCallback)
 -> m (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextActivateCallback IO ()
cb
    C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextActivateCallback C_TextActivateCallback
cb' IO (FunPtr C_TextActivateCallback)
-> (FunPtr C_TextActivateCallback
    -> IO (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextActivateCallback
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextActivateCallback` into a `C_TextActivateCallback`.
wrap_TextActivateCallback ::
    TextActivateCallback ->
    C_TextActivateCallback
wrap_TextActivateCallback :: IO () -> C_TextActivateCallback
wrap_TextActivateCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [activate](#signal:activate) 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' text #activate callback
-- @
-- 
-- 
onTextActivate :: (IsText a, MonadIO m) => a -> TextActivateCallback -> m SignalHandlerId
onTextActivate :: a -> IO () -> m SignalHandlerId
onTextActivate obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextActivateCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextActivateCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "activate" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [activate](#signal:activate) 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' text #activate callback
-- @
-- 
-- 
afterTextActivate :: (IsText a, MonadIO m) => a -> TextActivateCallback -> m SignalHandlerId
afterTextActivate :: a -> IO () -> m SignalHandlerId
afterTextActivate obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextActivateCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextActivateCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "activate" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextActivateSignalInfo
instance SignalInfo TextActivateSignalInfo where
    type HaskellCallbackType TextActivateSignalInfo = TextActivateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextActivateCallback cb
        cb'' <- mk_TextActivateCallback cb'
        connectSignalFunPtr obj "activate" cb'' connectMode detail

#endif

-- signal Text::backspace
-- | The [backspace](#signal:backspace) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted when the user asks for it.
-- 
-- The default bindings for this signal are
-- Backspace and Shift-Backspace.
type TextBackspaceCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextBackspace :: MonadIO m => TextBackspaceCallback -> m (GClosure C_TextBackspaceCallback)
genClosure_TextBackspace :: IO () -> m (GClosure C_TextActivateCallback)
genClosure_TextBackspace cb :: IO ()
cb = IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextActivateCallback)
 -> m (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextBackspaceCallback IO ()
cb
    C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextBackspaceCallback C_TextActivateCallback
cb' IO (FunPtr C_TextActivateCallback)
-> (FunPtr C_TextActivateCallback
    -> IO (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextActivateCallback
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextBackspaceCallback` into a `C_TextBackspaceCallback`.
wrap_TextBackspaceCallback ::
    TextBackspaceCallback ->
    C_TextBackspaceCallback
wrap_TextBackspaceCallback :: IO () -> C_TextActivateCallback
wrap_TextBackspaceCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [backspace](#signal:backspace) 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' text #backspace callback
-- @
-- 
-- 
onTextBackspace :: (IsText a, MonadIO m) => a -> TextBackspaceCallback -> m SignalHandlerId
onTextBackspace :: a -> IO () -> m SignalHandlerId
onTextBackspace obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextBackspaceCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextBackspaceCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "backspace" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [backspace](#signal:backspace) 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' text #backspace callback
-- @
-- 
-- 
afterTextBackspace :: (IsText a, MonadIO m) => a -> TextBackspaceCallback -> m SignalHandlerId
afterTextBackspace :: a -> IO () -> m SignalHandlerId
afterTextBackspace obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextBackspaceCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextBackspaceCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "backspace" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextBackspaceSignalInfo
instance SignalInfo TextBackspaceSignalInfo where
    type HaskellCallbackType TextBackspaceSignalInfo = TextBackspaceCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextBackspaceCallback cb
        cb'' <- mk_TextBackspaceCallback cb'
        connectSignalFunPtr obj "backspace" cb'' connectMode detail

#endif

-- signal Text::copy-clipboard
-- | The [copyClipboard](#signal:copyClipboard) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to copy the selection to the clipboard.
-- 
-- The default bindings for this signal are
-- Ctrl-c and Ctrl-Insert.
type TextCopyClipboardCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextCopyClipboard :: MonadIO m => TextCopyClipboardCallback -> m (GClosure C_TextCopyClipboardCallback)
genClosure_TextCopyClipboard :: IO () -> m (GClosure C_TextActivateCallback)
genClosure_TextCopyClipboard cb :: IO ()
cb = IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextActivateCallback)
 -> m (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextCopyClipboardCallback IO ()
cb
    C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextCopyClipboardCallback C_TextActivateCallback
cb' IO (FunPtr C_TextActivateCallback)
-> (FunPtr C_TextActivateCallback
    -> IO (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextActivateCallback
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextCopyClipboardCallback` into a `C_TextCopyClipboardCallback`.
wrap_TextCopyClipboardCallback ::
    TextCopyClipboardCallback ->
    C_TextCopyClipboardCallback
wrap_TextCopyClipboardCallback :: IO () -> C_TextActivateCallback
wrap_TextCopyClipboardCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [copyClipboard](#signal:copyClipboard) 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' text #copyClipboard callback
-- @
-- 
-- 
onTextCopyClipboard :: (IsText a, MonadIO m) => a -> TextCopyClipboardCallback -> m SignalHandlerId
onTextCopyClipboard :: a -> IO () -> m SignalHandlerId
onTextCopyClipboard obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextCopyClipboardCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextCopyClipboardCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "copy-clipboard" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [copyClipboard](#signal:copyClipboard) 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' text #copyClipboard callback
-- @
-- 
-- 
afterTextCopyClipboard :: (IsText a, MonadIO m) => a -> TextCopyClipboardCallback -> m SignalHandlerId
afterTextCopyClipboard :: a -> IO () -> m SignalHandlerId
afterTextCopyClipboard obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextCopyClipboardCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextCopyClipboardCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "copy-clipboard" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextCopyClipboardSignalInfo
instance SignalInfo TextCopyClipboardSignalInfo where
    type HaskellCallbackType TextCopyClipboardSignalInfo = TextCopyClipboardCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextCopyClipboardCallback cb
        cb'' <- mk_TextCopyClipboardCallback cb'
        connectSignalFunPtr obj "copy-clipboard" cb'' connectMode detail

#endif

-- signal Text::cut-clipboard
-- | The [cutClipboard](#signal:cutClipboard) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to cut the selection to the clipboard.
-- 
-- The default bindings for this signal are
-- Ctrl-x and Shift-Delete.
type TextCutClipboardCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextCutClipboard :: MonadIO m => TextCutClipboardCallback -> m (GClosure C_TextCutClipboardCallback)
genClosure_TextCutClipboard :: IO () -> m (GClosure C_TextActivateCallback)
genClosure_TextCutClipboard cb :: IO ()
cb = IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextActivateCallback)
 -> m (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextCutClipboardCallback IO ()
cb
    C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextCutClipboardCallback C_TextActivateCallback
cb' IO (FunPtr C_TextActivateCallback)
-> (FunPtr C_TextActivateCallback
    -> IO (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextActivateCallback
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextCutClipboardCallback` into a `C_TextCutClipboardCallback`.
wrap_TextCutClipboardCallback ::
    TextCutClipboardCallback ->
    C_TextCutClipboardCallback
wrap_TextCutClipboardCallback :: IO () -> C_TextActivateCallback
wrap_TextCutClipboardCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [cutClipboard](#signal:cutClipboard) 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' text #cutClipboard callback
-- @
-- 
-- 
onTextCutClipboard :: (IsText a, MonadIO m) => a -> TextCutClipboardCallback -> m SignalHandlerId
onTextCutClipboard :: a -> IO () -> m SignalHandlerId
onTextCutClipboard obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextCutClipboardCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextCutClipboardCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "cut-clipboard" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [cutClipboard](#signal:cutClipboard) 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' text #cutClipboard callback
-- @
-- 
-- 
afterTextCutClipboard :: (IsText a, MonadIO m) => a -> TextCutClipboardCallback -> m SignalHandlerId
afterTextCutClipboard :: a -> IO () -> m SignalHandlerId
afterTextCutClipboard obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextCutClipboardCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextCutClipboardCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "cut-clipboard" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextCutClipboardSignalInfo
instance SignalInfo TextCutClipboardSignalInfo where
    type HaskellCallbackType TextCutClipboardSignalInfo = TextCutClipboardCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextCutClipboardCallback cb
        cb'' <- mk_TextCutClipboardCallback cb'
        connectSignalFunPtr obj "cut-clipboard" cb'' connectMode detail

#endif

-- signal Text::delete-from-cursor
-- | The [deleteFromCursor](#signal:deleteFromCursor) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted when the user initiates a text deletion.
-- 
-- If the /@type@/ is 'GI.Gtk.Enums.DeleteTypeChars', GTK deletes the selection
-- if there is one, otherwise it deletes the requested number
-- of characters.
-- 
-- The default bindings for this signal are
-- Delete for deleting a character and Ctrl-Delete for
-- deleting a word.
type TextDeleteFromCursorCallback =
    Gtk.Enums.DeleteType
    -- ^ /@type@/: the granularity of the deletion, as a t'GI.Gtk.Enums.DeleteType'
    -> Int32
    -- ^ /@count@/: the number of /@type@/ units to delete
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextDeleteFromCursorCallback`@.
noTextDeleteFromCursorCallback :: Maybe TextDeleteFromCursorCallback
noTextDeleteFromCursorCallback :: Maybe TextDeleteFromCursorCallback
noTextDeleteFromCursorCallback = Maybe TextDeleteFromCursorCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextDeleteFromCursor :: MonadIO m => TextDeleteFromCursorCallback -> m (GClosure C_TextDeleteFromCursorCallback)
genClosure_TextDeleteFromCursor :: TextDeleteFromCursorCallback
-> m (GClosure C_TextDeleteFromCursorCallback)
genClosure_TextDeleteFromCursor cb :: TextDeleteFromCursorCallback
cb = IO (GClosure C_TextDeleteFromCursorCallback)
-> m (GClosure C_TextDeleteFromCursorCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextDeleteFromCursorCallback)
 -> m (GClosure C_TextDeleteFromCursorCallback))
-> IO (GClosure C_TextDeleteFromCursorCallback)
-> m (GClosure C_TextDeleteFromCursorCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextDeleteFromCursorCallback
cb' = TextDeleteFromCursorCallback -> C_TextDeleteFromCursorCallback
wrap_TextDeleteFromCursorCallback TextDeleteFromCursorCallback
cb
    C_TextDeleteFromCursorCallback
-> IO (FunPtr C_TextDeleteFromCursorCallback)
mk_TextDeleteFromCursorCallback C_TextDeleteFromCursorCallback
cb' IO (FunPtr C_TextDeleteFromCursorCallback)
-> (FunPtr C_TextDeleteFromCursorCallback
    -> IO (GClosure C_TextDeleteFromCursorCallback))
-> IO (GClosure C_TextDeleteFromCursorCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextDeleteFromCursorCallback
-> IO (GClosure C_TextDeleteFromCursorCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextDeleteFromCursorCallback` into a `C_TextDeleteFromCursorCallback`.
wrap_TextDeleteFromCursorCallback ::
    TextDeleteFromCursorCallback ->
    C_TextDeleteFromCursorCallback
wrap_TextDeleteFromCursorCallback :: TextDeleteFromCursorCallback -> C_TextDeleteFromCursorCallback
wrap_TextDeleteFromCursorCallback _cb :: TextDeleteFromCursorCallback
_cb _ type_ :: CUInt
type_ count :: Int32
count _ = do
    let type_' :: DeleteType
type_' = (Int -> DeleteType
forall a. Enum a => Int -> a
toEnum (Int -> DeleteType) -> (CUInt -> Int) -> CUInt -> DeleteType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
type_
    TextDeleteFromCursorCallback
_cb  DeleteType
type_' Int32
count


-- | Connect a signal handler for the [deleteFromCursor](#signal:deleteFromCursor) 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' text #deleteFromCursor callback
-- @
-- 
-- 
onTextDeleteFromCursor :: (IsText a, MonadIO m) => a -> TextDeleteFromCursorCallback -> m SignalHandlerId
onTextDeleteFromCursor :: a -> TextDeleteFromCursorCallback -> m SignalHandlerId
onTextDeleteFromCursor obj :: a
obj cb :: TextDeleteFromCursorCallback
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_TextDeleteFromCursorCallback
cb' = TextDeleteFromCursorCallback -> C_TextDeleteFromCursorCallback
wrap_TextDeleteFromCursorCallback TextDeleteFromCursorCallback
cb
    FunPtr C_TextDeleteFromCursorCallback
cb'' <- C_TextDeleteFromCursorCallback
-> IO (FunPtr C_TextDeleteFromCursorCallback)
mk_TextDeleteFromCursorCallback C_TextDeleteFromCursorCallback
cb'
    a
-> Text
-> FunPtr C_TextDeleteFromCursorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "delete-from-cursor" FunPtr C_TextDeleteFromCursorCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deleteFromCursor](#signal:deleteFromCursor) 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' text #deleteFromCursor callback
-- @
-- 
-- 
afterTextDeleteFromCursor :: (IsText a, MonadIO m) => a -> TextDeleteFromCursorCallback -> m SignalHandlerId
afterTextDeleteFromCursor :: a -> TextDeleteFromCursorCallback -> m SignalHandlerId
afterTextDeleteFromCursor obj :: a
obj cb :: TextDeleteFromCursorCallback
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_TextDeleteFromCursorCallback
cb' = TextDeleteFromCursorCallback -> C_TextDeleteFromCursorCallback
wrap_TextDeleteFromCursorCallback TextDeleteFromCursorCallback
cb
    FunPtr C_TextDeleteFromCursorCallback
cb'' <- C_TextDeleteFromCursorCallback
-> IO (FunPtr C_TextDeleteFromCursorCallback)
mk_TextDeleteFromCursorCallback C_TextDeleteFromCursorCallback
cb'
    a
-> Text
-> FunPtr C_TextDeleteFromCursorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "delete-from-cursor" FunPtr C_TextDeleteFromCursorCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextDeleteFromCursorSignalInfo
instance SignalInfo TextDeleteFromCursorSignalInfo where
    type HaskellCallbackType TextDeleteFromCursorSignalInfo = TextDeleteFromCursorCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextDeleteFromCursorCallback cb
        cb'' <- mk_TextDeleteFromCursorCallback cb'
        connectSignalFunPtr obj "delete-from-cursor" cb'' connectMode detail

#endif

-- signal Text::insert-at-cursor
-- | The [insertAtCursor](#signal:insertAtCursor) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted when the user initiates the insertion of a
-- fixed string at the cursor.
-- 
-- This signal has no default bindings.
type TextInsertAtCursorCallback =
    T.Text
    -- ^ /@string@/: the string to insert
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextInsertAtCursorCallback`@.
noTextInsertAtCursorCallback :: Maybe TextInsertAtCursorCallback
noTextInsertAtCursorCallback :: Maybe TextInsertAtCursorCallback
noTextInsertAtCursorCallback = Maybe TextInsertAtCursorCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextInsertAtCursor :: MonadIO m => TextInsertAtCursorCallback -> m (GClosure C_TextInsertAtCursorCallback)
genClosure_TextInsertAtCursor :: TextInsertAtCursorCallback
-> m (GClosure C_TextInsertAtCursorCallback)
genClosure_TextInsertAtCursor cb :: TextInsertAtCursorCallback
cb = IO (GClosure C_TextInsertAtCursorCallback)
-> m (GClosure C_TextInsertAtCursorCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextInsertAtCursorCallback)
 -> m (GClosure C_TextInsertAtCursorCallback))
-> IO (GClosure C_TextInsertAtCursorCallback)
-> m (GClosure C_TextInsertAtCursorCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextInsertAtCursorCallback
cb' = TextInsertAtCursorCallback -> C_TextInsertAtCursorCallback
wrap_TextInsertAtCursorCallback TextInsertAtCursorCallback
cb
    C_TextInsertAtCursorCallback
-> IO (FunPtr C_TextInsertAtCursorCallback)
mk_TextInsertAtCursorCallback C_TextInsertAtCursorCallback
cb' IO (FunPtr C_TextInsertAtCursorCallback)
-> (FunPtr C_TextInsertAtCursorCallback
    -> IO (GClosure C_TextInsertAtCursorCallback))
-> IO (GClosure C_TextInsertAtCursorCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextInsertAtCursorCallback
-> IO (GClosure C_TextInsertAtCursorCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextInsertAtCursorCallback` into a `C_TextInsertAtCursorCallback`.
wrap_TextInsertAtCursorCallback ::
    TextInsertAtCursorCallback ->
    C_TextInsertAtCursorCallback
wrap_TextInsertAtCursorCallback :: TextInsertAtCursorCallback -> C_TextInsertAtCursorCallback
wrap_TextInsertAtCursorCallback _cb :: TextInsertAtCursorCallback
_cb _ string :: CString
string _ = do
    Text
string' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
string
    TextInsertAtCursorCallback
_cb  Text
string'


-- | Connect a signal handler for the [insertAtCursor](#signal:insertAtCursor) 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' text #insertAtCursor callback
-- @
-- 
-- 
onTextInsertAtCursor :: (IsText a, MonadIO m) => a -> TextInsertAtCursorCallback -> m SignalHandlerId
onTextInsertAtCursor :: a -> TextInsertAtCursorCallback -> m SignalHandlerId
onTextInsertAtCursor obj :: a
obj cb :: TextInsertAtCursorCallback
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_TextInsertAtCursorCallback
cb' = TextInsertAtCursorCallback -> C_TextInsertAtCursorCallback
wrap_TextInsertAtCursorCallback TextInsertAtCursorCallback
cb
    FunPtr C_TextInsertAtCursorCallback
cb'' <- C_TextInsertAtCursorCallback
-> IO (FunPtr C_TextInsertAtCursorCallback)
mk_TextInsertAtCursorCallback C_TextInsertAtCursorCallback
cb'
    a
-> Text
-> FunPtr C_TextInsertAtCursorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "insert-at-cursor" FunPtr C_TextInsertAtCursorCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [insertAtCursor](#signal:insertAtCursor) 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' text #insertAtCursor callback
-- @
-- 
-- 
afterTextInsertAtCursor :: (IsText a, MonadIO m) => a -> TextInsertAtCursorCallback -> m SignalHandlerId
afterTextInsertAtCursor :: a -> TextInsertAtCursorCallback -> m SignalHandlerId
afterTextInsertAtCursor obj :: a
obj cb :: TextInsertAtCursorCallback
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_TextInsertAtCursorCallback
cb' = TextInsertAtCursorCallback -> C_TextInsertAtCursorCallback
wrap_TextInsertAtCursorCallback TextInsertAtCursorCallback
cb
    FunPtr C_TextInsertAtCursorCallback
cb'' <- C_TextInsertAtCursorCallback
-> IO (FunPtr C_TextInsertAtCursorCallback)
mk_TextInsertAtCursorCallback C_TextInsertAtCursorCallback
cb'
    a
-> Text
-> FunPtr C_TextInsertAtCursorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "insert-at-cursor" FunPtr C_TextInsertAtCursorCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextInsertAtCursorSignalInfo
instance SignalInfo TextInsertAtCursorSignalInfo where
    type HaskellCallbackType TextInsertAtCursorSignalInfo = TextInsertAtCursorCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextInsertAtCursorCallback cb
        cb'' <- mk_TextInsertAtCursorCallback cb'
        connectSignalFunPtr obj "insert-at-cursor" cb'' connectMode detail

#endif

-- signal Text::insert-emoji
-- | The [insertEmoji](#signal:insertEmoji) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to present the Emoji chooser for the /@self@/.
-- 
-- The default bindings for this signal are Ctrl-. and Ctrl-;
type TextInsertEmojiCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextInsertEmoji :: MonadIO m => TextInsertEmojiCallback -> m (GClosure C_TextInsertEmojiCallback)
genClosure_TextInsertEmoji :: IO () -> m (GClosure C_TextActivateCallback)
genClosure_TextInsertEmoji cb :: IO ()
cb = IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextActivateCallback)
 -> m (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextInsertEmojiCallback IO ()
cb
    C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextInsertEmojiCallback C_TextActivateCallback
cb' IO (FunPtr C_TextActivateCallback)
-> (FunPtr C_TextActivateCallback
    -> IO (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextActivateCallback
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextInsertEmojiCallback` into a `C_TextInsertEmojiCallback`.
wrap_TextInsertEmojiCallback ::
    TextInsertEmojiCallback ->
    C_TextInsertEmojiCallback
wrap_TextInsertEmojiCallback :: IO () -> C_TextActivateCallback
wrap_TextInsertEmojiCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [insertEmoji](#signal:insertEmoji) 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' text #insertEmoji callback
-- @
-- 
-- 
onTextInsertEmoji :: (IsText a, MonadIO m) => a -> TextInsertEmojiCallback -> m SignalHandlerId
onTextInsertEmoji :: a -> IO () -> m SignalHandlerId
onTextInsertEmoji obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextInsertEmojiCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextInsertEmojiCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "insert-emoji" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [insertEmoji](#signal:insertEmoji) 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' text #insertEmoji callback
-- @
-- 
-- 
afterTextInsertEmoji :: (IsText a, MonadIO m) => a -> TextInsertEmojiCallback -> m SignalHandlerId
afterTextInsertEmoji :: a -> IO () -> m SignalHandlerId
afterTextInsertEmoji obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextInsertEmojiCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextInsertEmojiCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "insert-emoji" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextInsertEmojiSignalInfo
instance SignalInfo TextInsertEmojiSignalInfo where
    type HaskellCallbackType TextInsertEmojiSignalInfo = TextInsertEmojiCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextInsertEmojiCallback cb
        cb'' <- mk_TextInsertEmojiCallback cb'
        connectSignalFunPtr obj "insert-emoji" cb'' connectMode detail

#endif

-- signal Text::move-cursor
-- | The [moveCursor](#signal:moveCursor) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted when the user initiates a cursor movement.
-- If the cursor is not visible in /@self@/, this signal causes
-- the viewport to be moved instead.
-- 
-- Applications should not connect to it, but may emit it with
-- @/g_signal_emit_by_name()/@ if they need to control the cursor
-- programmatically.
-- 
-- The default bindings for this signal come in two variants,
-- the variant with the Shift modifier extends the selection,
-- the variant without the Shift modifer does not.
-- There are too many key combinations to list them all here.
-- 
-- * Arrow keys move by individual characters\/lines
-- * Ctrl-arrow key combinations move by words\/paragraphs
-- * Home\/End keys move to the ends of the buffer
type TextMoveCursorCallback =
    Gtk.Enums.MovementStep
    -- ^ /@step@/: the granularity of the move, as a t'GI.Gtk.Enums.MovementStep'
    -> Int32
    -- ^ /@count@/: the number of /@step@/ units to move
    -> Bool
    -- ^ /@extend@/: 'P.True' if the move should extend the selection
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextMoveCursorCallback`@.
noTextMoveCursorCallback :: Maybe TextMoveCursorCallback
noTextMoveCursorCallback :: Maybe TextMoveCursorCallback
noTextMoveCursorCallback = Maybe TextMoveCursorCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextMoveCursor :: MonadIO m => TextMoveCursorCallback -> m (GClosure C_TextMoveCursorCallback)
genClosure_TextMoveCursor :: TextMoveCursorCallback -> m (GClosure C_TextMoveCursorCallback)
genClosure_TextMoveCursor cb :: TextMoveCursorCallback
cb = IO (GClosure C_TextMoveCursorCallback)
-> m (GClosure C_TextMoveCursorCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextMoveCursorCallback)
 -> m (GClosure C_TextMoveCursorCallback))
-> IO (GClosure C_TextMoveCursorCallback)
-> m (GClosure C_TextMoveCursorCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextMoveCursorCallback
cb' = TextMoveCursorCallback -> C_TextMoveCursorCallback
wrap_TextMoveCursorCallback TextMoveCursorCallback
cb
    C_TextMoveCursorCallback -> IO (FunPtr C_TextMoveCursorCallback)
mk_TextMoveCursorCallback C_TextMoveCursorCallback
cb' IO (FunPtr C_TextMoveCursorCallback)
-> (FunPtr C_TextMoveCursorCallback
    -> IO (GClosure C_TextMoveCursorCallback))
-> IO (GClosure C_TextMoveCursorCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextMoveCursorCallback
-> IO (GClosure C_TextMoveCursorCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextMoveCursorCallback` into a `C_TextMoveCursorCallback`.
wrap_TextMoveCursorCallback ::
    TextMoveCursorCallback ->
    C_TextMoveCursorCallback
wrap_TextMoveCursorCallback :: TextMoveCursorCallback -> C_TextMoveCursorCallback
wrap_TextMoveCursorCallback _cb :: TextMoveCursorCallback
_cb _ step :: CUInt
step count :: Int32
count extend :: CInt
extend _ = do
    let step' :: MovementStep
step' = (Int -> MovementStep
forall a. Enum a => Int -> a
toEnum (Int -> MovementStep) -> (CUInt -> Int) -> CUInt -> MovementStep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
step
    let extend' :: Bool
extend' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
extend
    TextMoveCursorCallback
_cb  MovementStep
step' Int32
count Bool
extend'


-- | Connect a signal handler for the [moveCursor](#signal:moveCursor) 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' text #moveCursor callback
-- @
-- 
-- 
onTextMoveCursor :: (IsText a, MonadIO m) => a -> TextMoveCursorCallback -> m SignalHandlerId
onTextMoveCursor :: a -> TextMoveCursorCallback -> m SignalHandlerId
onTextMoveCursor obj :: a
obj cb :: TextMoveCursorCallback
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_TextMoveCursorCallback
cb' = TextMoveCursorCallback -> C_TextMoveCursorCallback
wrap_TextMoveCursorCallback TextMoveCursorCallback
cb
    FunPtr C_TextMoveCursorCallback
cb'' <- C_TextMoveCursorCallback -> IO (FunPtr C_TextMoveCursorCallback)
mk_TextMoveCursorCallback C_TextMoveCursorCallback
cb'
    a
-> Text
-> FunPtr C_TextMoveCursorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "move-cursor" FunPtr C_TextMoveCursorCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [moveCursor](#signal:moveCursor) 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' text #moveCursor callback
-- @
-- 
-- 
afterTextMoveCursor :: (IsText a, MonadIO m) => a -> TextMoveCursorCallback -> m SignalHandlerId
afterTextMoveCursor :: a -> TextMoveCursorCallback -> m SignalHandlerId
afterTextMoveCursor obj :: a
obj cb :: TextMoveCursorCallback
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_TextMoveCursorCallback
cb' = TextMoveCursorCallback -> C_TextMoveCursorCallback
wrap_TextMoveCursorCallback TextMoveCursorCallback
cb
    FunPtr C_TextMoveCursorCallback
cb'' <- C_TextMoveCursorCallback -> IO (FunPtr C_TextMoveCursorCallback)
mk_TextMoveCursorCallback C_TextMoveCursorCallback
cb'
    a
-> Text
-> FunPtr C_TextMoveCursorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "move-cursor" FunPtr C_TextMoveCursorCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextMoveCursorSignalInfo
instance SignalInfo TextMoveCursorSignalInfo where
    type HaskellCallbackType TextMoveCursorSignalInfo = TextMoveCursorCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextMoveCursorCallback cb
        cb'' <- mk_TextMoveCursorCallback cb'
        connectSignalFunPtr obj "move-cursor" cb'' connectMode detail

#endif

-- signal Text::paste-clipboard
-- | The [pasteClipboard](#signal:pasteClipboard) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to paste the contents of the clipboard
-- into the text view.
-- 
-- The default bindings for this signal are
-- Ctrl-v and Shift-Insert.
type TextPasteClipboardCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextPasteClipboard :: MonadIO m => TextPasteClipboardCallback -> m (GClosure C_TextPasteClipboardCallback)
genClosure_TextPasteClipboard :: IO () -> m (GClosure C_TextActivateCallback)
genClosure_TextPasteClipboard cb :: IO ()
cb = IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextActivateCallback)
 -> m (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextPasteClipboardCallback IO ()
cb
    C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextPasteClipboardCallback C_TextActivateCallback
cb' IO (FunPtr C_TextActivateCallback)
-> (FunPtr C_TextActivateCallback
    -> IO (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextActivateCallback
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextPasteClipboardCallback` into a `C_TextPasteClipboardCallback`.
wrap_TextPasteClipboardCallback ::
    TextPasteClipboardCallback ->
    C_TextPasteClipboardCallback
wrap_TextPasteClipboardCallback :: IO () -> C_TextActivateCallback
wrap_TextPasteClipboardCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [pasteClipboard](#signal:pasteClipboard) 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' text #pasteClipboard callback
-- @
-- 
-- 
onTextPasteClipboard :: (IsText a, MonadIO m) => a -> TextPasteClipboardCallback -> m SignalHandlerId
onTextPasteClipboard :: a -> IO () -> m SignalHandlerId
onTextPasteClipboard obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextPasteClipboardCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextPasteClipboardCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "paste-clipboard" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [pasteClipboard](#signal:pasteClipboard) 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' text #pasteClipboard callback
-- @
-- 
-- 
afterTextPasteClipboard :: (IsText a, MonadIO m) => a -> TextPasteClipboardCallback -> m SignalHandlerId
afterTextPasteClipboard :: a -> IO () -> m SignalHandlerId
afterTextPasteClipboard obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextPasteClipboardCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextPasteClipboardCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "paste-clipboard" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextPasteClipboardSignalInfo
instance SignalInfo TextPasteClipboardSignalInfo where
    type HaskellCallbackType TextPasteClipboardSignalInfo = TextPasteClipboardCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextPasteClipboardCallback cb
        cb'' <- mk_TextPasteClipboardCallback cb'
        connectSignalFunPtr obj "paste-clipboard" cb'' connectMode detail

#endif

-- signal Text::populate-popup
-- | The [populatePopup](#signal:populatePopup) signal gets emitted before showing the
-- context menu of the self.
-- 
-- If you need to add items to the context menu, connect
-- to this signal and append your items to the /@widget@/, which
-- will be a t'GI.Gtk.Objects.Menu.Menu' in this case.
-- 
-- If t'GI.Gtk.Objects.Text.Text':@/populate-all/@ is 'P.True', this signal will
-- also be emitted to populate touch popups. In this case,
-- /@widget@/ will be a different container, e.g. a t'GI.Gtk.Objects.Toolbar.Toolbar'.
-- The signal handler should not make assumptions about the
-- type of /@widget@/.
type TextPopulatePopupCallback =
    Gtk.Widget.Widget
    -- ^ /@widget@/: the container that is being populated
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextPopulatePopupCallback`@.
noTextPopulatePopupCallback :: Maybe TextPopulatePopupCallback
noTextPopulatePopupCallback :: Maybe TextPopulatePopupCallback
noTextPopulatePopupCallback = Maybe TextPopulatePopupCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextPopulatePopup :: MonadIO m => TextPopulatePopupCallback -> m (GClosure C_TextPopulatePopupCallback)
genClosure_TextPopulatePopup :: TextPopulatePopupCallback
-> m (GClosure C_TextPopulatePopupCallback)
genClosure_TextPopulatePopup cb :: TextPopulatePopupCallback
cb = IO (GClosure C_TextPopulatePopupCallback)
-> m (GClosure C_TextPopulatePopupCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextPopulatePopupCallback)
 -> m (GClosure C_TextPopulatePopupCallback))
-> IO (GClosure C_TextPopulatePopupCallback)
-> m (GClosure C_TextPopulatePopupCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextPopulatePopupCallback
cb' = TextPopulatePopupCallback -> C_TextPopulatePopupCallback
wrap_TextPopulatePopupCallback TextPopulatePopupCallback
cb
    C_TextPopulatePopupCallback
-> IO (FunPtr C_TextPopulatePopupCallback)
mk_TextPopulatePopupCallback C_TextPopulatePopupCallback
cb' IO (FunPtr C_TextPopulatePopupCallback)
-> (FunPtr C_TextPopulatePopupCallback
    -> IO (GClosure C_TextPopulatePopupCallback))
-> IO (GClosure C_TextPopulatePopupCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextPopulatePopupCallback
-> IO (GClosure C_TextPopulatePopupCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextPopulatePopupCallback` into a `C_TextPopulatePopupCallback`.
wrap_TextPopulatePopupCallback ::
    TextPopulatePopupCallback ->
    C_TextPopulatePopupCallback
wrap_TextPopulatePopupCallback :: TextPopulatePopupCallback -> C_TextPopulatePopupCallback
wrap_TextPopulatePopupCallback _cb :: TextPopulatePopupCallback
_cb _ widget :: Ptr Widget
widget _ = do
    Widget
widget' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
widget
    TextPopulatePopupCallback
_cb  Widget
widget'


-- | Connect a signal handler for the [populatePopup](#signal:populatePopup) 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' text #populatePopup callback
-- @
-- 
-- 
onTextPopulatePopup :: (IsText a, MonadIO m) => a -> TextPopulatePopupCallback -> m SignalHandlerId
onTextPopulatePopup :: a -> TextPopulatePopupCallback -> m SignalHandlerId
onTextPopulatePopup obj :: a
obj cb :: TextPopulatePopupCallback
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_TextPopulatePopupCallback
cb' = TextPopulatePopupCallback -> C_TextPopulatePopupCallback
wrap_TextPopulatePopupCallback TextPopulatePopupCallback
cb
    FunPtr C_TextPopulatePopupCallback
cb'' <- C_TextPopulatePopupCallback
-> IO (FunPtr C_TextPopulatePopupCallback)
mk_TextPopulatePopupCallback C_TextPopulatePopupCallback
cb'
    a
-> Text
-> FunPtr C_TextPopulatePopupCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "populate-popup" FunPtr C_TextPopulatePopupCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [populatePopup](#signal:populatePopup) 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' text #populatePopup callback
-- @
-- 
-- 
afterTextPopulatePopup :: (IsText a, MonadIO m) => a -> TextPopulatePopupCallback -> m SignalHandlerId
afterTextPopulatePopup :: a -> TextPopulatePopupCallback -> m SignalHandlerId
afterTextPopulatePopup obj :: a
obj cb :: TextPopulatePopupCallback
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_TextPopulatePopupCallback
cb' = TextPopulatePopupCallback -> C_TextPopulatePopupCallback
wrap_TextPopulatePopupCallback TextPopulatePopupCallback
cb
    FunPtr C_TextPopulatePopupCallback
cb'' <- C_TextPopulatePopupCallback
-> IO (FunPtr C_TextPopulatePopupCallback)
mk_TextPopulatePopupCallback C_TextPopulatePopupCallback
cb'
    a
-> Text
-> FunPtr C_TextPopulatePopupCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "populate-popup" FunPtr C_TextPopulatePopupCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextPopulatePopupSignalInfo
instance SignalInfo TextPopulatePopupSignalInfo where
    type HaskellCallbackType TextPopulatePopupSignalInfo = TextPopulatePopupCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextPopulatePopupCallback cb
        cb'' <- mk_TextPopulatePopupCallback cb'
        connectSignalFunPtr obj "populate-popup" cb'' connectMode detail

#endif

-- signal Text::preedit-changed
-- | If an input method is used, the typed text will not immediately
-- be committed to the buffer. So if you are interested in the text,
-- connect to this signal.
type TextPreeditChangedCallback =
    T.Text
    -- ^ /@preedit@/: the current preedit string
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TextPreeditChangedCallback`@.
noTextPreeditChangedCallback :: Maybe TextPreeditChangedCallback
noTextPreeditChangedCallback :: Maybe TextInsertAtCursorCallback
noTextPreeditChangedCallback = Maybe TextInsertAtCursorCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextPreeditChanged :: MonadIO m => TextPreeditChangedCallback -> m (GClosure C_TextPreeditChangedCallback)
genClosure_TextPreeditChanged :: TextInsertAtCursorCallback
-> m (GClosure C_TextInsertAtCursorCallback)
genClosure_TextPreeditChanged cb :: TextInsertAtCursorCallback
cb = IO (GClosure C_TextInsertAtCursorCallback)
-> m (GClosure C_TextInsertAtCursorCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextInsertAtCursorCallback)
 -> m (GClosure C_TextInsertAtCursorCallback))
-> IO (GClosure C_TextInsertAtCursorCallback)
-> m (GClosure C_TextInsertAtCursorCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextInsertAtCursorCallback
cb' = TextInsertAtCursorCallback -> C_TextInsertAtCursorCallback
wrap_TextPreeditChangedCallback TextInsertAtCursorCallback
cb
    C_TextInsertAtCursorCallback
-> IO (FunPtr C_TextInsertAtCursorCallback)
mk_TextPreeditChangedCallback C_TextInsertAtCursorCallback
cb' IO (FunPtr C_TextInsertAtCursorCallback)
-> (FunPtr C_TextInsertAtCursorCallback
    -> IO (GClosure C_TextInsertAtCursorCallback))
-> IO (GClosure C_TextInsertAtCursorCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextInsertAtCursorCallback
-> IO (GClosure C_TextInsertAtCursorCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextPreeditChangedCallback` into a `C_TextPreeditChangedCallback`.
wrap_TextPreeditChangedCallback ::
    TextPreeditChangedCallback ->
    C_TextPreeditChangedCallback
wrap_TextPreeditChangedCallback :: TextInsertAtCursorCallback -> C_TextInsertAtCursorCallback
wrap_TextPreeditChangedCallback _cb :: TextInsertAtCursorCallback
_cb _ preedit :: CString
preedit _ = do
    Text
preedit' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
preedit
    TextInsertAtCursorCallback
_cb  Text
preedit'


-- | Connect a signal handler for the [preeditChanged](#signal:preeditChanged) 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' text #preeditChanged callback
-- @
-- 
-- 
onTextPreeditChanged :: (IsText a, MonadIO m) => a -> TextPreeditChangedCallback -> m SignalHandlerId
onTextPreeditChanged :: a -> TextInsertAtCursorCallback -> m SignalHandlerId
onTextPreeditChanged obj :: a
obj cb :: TextInsertAtCursorCallback
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_TextInsertAtCursorCallback
cb' = TextInsertAtCursorCallback -> C_TextInsertAtCursorCallback
wrap_TextPreeditChangedCallback TextInsertAtCursorCallback
cb
    FunPtr C_TextInsertAtCursorCallback
cb'' <- C_TextInsertAtCursorCallback
-> IO (FunPtr C_TextInsertAtCursorCallback)
mk_TextPreeditChangedCallback C_TextInsertAtCursorCallback
cb'
    a
-> Text
-> FunPtr C_TextInsertAtCursorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "preedit-changed" FunPtr C_TextInsertAtCursorCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [preeditChanged](#signal:preeditChanged) 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' text #preeditChanged callback
-- @
-- 
-- 
afterTextPreeditChanged :: (IsText a, MonadIO m) => a -> TextPreeditChangedCallback -> m SignalHandlerId
afterTextPreeditChanged :: a -> TextInsertAtCursorCallback -> m SignalHandlerId
afterTextPreeditChanged obj :: a
obj cb :: TextInsertAtCursorCallback
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_TextInsertAtCursorCallback
cb' = TextInsertAtCursorCallback -> C_TextInsertAtCursorCallback
wrap_TextPreeditChangedCallback TextInsertAtCursorCallback
cb
    FunPtr C_TextInsertAtCursorCallback
cb'' <- C_TextInsertAtCursorCallback
-> IO (FunPtr C_TextInsertAtCursorCallback)
mk_TextPreeditChangedCallback C_TextInsertAtCursorCallback
cb'
    a
-> Text
-> FunPtr C_TextInsertAtCursorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "preedit-changed" FunPtr C_TextInsertAtCursorCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextPreeditChangedSignalInfo
instance SignalInfo TextPreeditChangedSignalInfo where
    type HaskellCallbackType TextPreeditChangedSignalInfo = TextPreeditChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextPreeditChangedCallback cb
        cb'' <- mk_TextPreeditChangedCallback cb'
        connectSignalFunPtr obj "preedit-changed" cb'' connectMode detail

#endif

-- signal Text::toggle-overwrite
-- | The [toggleOverwrite](#signal:toggleOverwrite) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to toggle the overwrite mode of the self.
-- 
-- The default bindings for this signal is Insert.
type TextToggleOverwriteCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_TextToggleOverwrite :: MonadIO m => TextToggleOverwriteCallback -> m (GClosure C_TextToggleOverwriteCallback)
genClosure_TextToggleOverwrite :: IO () -> m (GClosure C_TextActivateCallback)
genClosure_TextToggleOverwrite cb :: IO ()
cb = IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TextActivateCallback)
 -> m (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
-> m (GClosure C_TextActivateCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextToggleOverwriteCallback IO ()
cb
    C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextToggleOverwriteCallback C_TextActivateCallback
cb' IO (FunPtr C_TextActivateCallback)
-> (FunPtr C_TextActivateCallback
    -> IO (GClosure C_TextActivateCallback))
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TextActivateCallback
-> IO (GClosure C_TextActivateCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TextToggleOverwriteCallback` into a `C_TextToggleOverwriteCallback`.
wrap_TextToggleOverwriteCallback ::
    TextToggleOverwriteCallback ->
    C_TextToggleOverwriteCallback
wrap_TextToggleOverwriteCallback :: IO () -> C_TextActivateCallback
wrap_TextToggleOverwriteCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [toggleOverwrite](#signal:toggleOverwrite) 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' text #toggleOverwrite callback
-- @
-- 
-- 
onTextToggleOverwrite :: (IsText a, MonadIO m) => a -> TextToggleOverwriteCallback -> m SignalHandlerId
onTextToggleOverwrite :: a -> IO () -> m SignalHandlerId
onTextToggleOverwrite obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextToggleOverwriteCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextToggleOverwriteCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "toggle-overwrite" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [toggleOverwrite](#signal:toggleOverwrite) 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' text #toggleOverwrite callback
-- @
-- 
-- 
afterTextToggleOverwrite :: (IsText a, MonadIO m) => a -> TextToggleOverwriteCallback -> m SignalHandlerId
afterTextToggleOverwrite :: a -> IO () -> m SignalHandlerId
afterTextToggleOverwrite obj :: a
obj cb :: 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_TextActivateCallback
cb' = IO () -> C_TextActivateCallback
wrap_TextToggleOverwriteCallback IO ()
cb
    FunPtr C_TextActivateCallback
cb'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextToggleOverwriteCallback C_TextActivateCallback
cb'
    a
-> Text
-> FunPtr C_TextActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "toggle-overwrite" FunPtr C_TextActivateCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TextToggleOverwriteSignalInfo
instance SignalInfo TextToggleOverwriteSignalInfo where
    type HaskellCallbackType TextToggleOverwriteSignalInfo = TextToggleOverwriteCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TextToggleOverwriteCallback cb
        cb'' <- mk_TextToggleOverwriteCallback cb'
        connectSignalFunPtr obj "toggle-overwrite" cb'' connectMode detail

#endif

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

-- | Get the value of the “@activates-default@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #activatesDefault
-- @
getTextActivatesDefault :: (MonadIO m, IsText o) => o -> m Bool
getTextActivatesDefault :: o -> m Bool
getTextActivatesDefault obj :: 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 "activates-default"

-- | Set the value of the “@activates-default@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #activatesDefault 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextActivatesDefault :: (MonadIO m, IsText o) => o -> Bool -> m ()
setTextActivatesDefault :: o -> Bool -> m ()
setTextActivatesDefault obj :: o
obj val :: 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 "activates-default" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@activates-default@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextActivatesDefault :: (IsText o) => Bool -> IO (GValueConstruct o)
constructTextActivatesDefault :: Bool -> IO (GValueConstruct o)
constructTextActivatesDefault val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "activates-default" Bool
val

#if defined(ENABLE_OVERLOADING)
data TextActivatesDefaultPropertyInfo
instance AttrInfo TextActivatesDefaultPropertyInfo where
    type AttrAllowedOps TextActivatesDefaultPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextActivatesDefaultPropertyInfo = IsText
    type AttrSetTypeConstraint TextActivatesDefaultPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TextActivatesDefaultPropertyInfo = (~) Bool
    type AttrTransferType TextActivatesDefaultPropertyInfo = Bool
    type AttrGetType TextActivatesDefaultPropertyInfo = Bool
    type AttrLabel TextActivatesDefaultPropertyInfo = "activates-default"
    type AttrOrigin TextActivatesDefaultPropertyInfo = Text
    attrGet = getTextActivatesDefault
    attrSet = setTextActivatesDefault
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextActivatesDefault
    attrClear = undefined
#endif

-- VVV Prop "attributes"
   -- Type: TInterface (Name {namespace = "Pango", name = "AttrList"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just False)

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

-- | Set the value of the “@attributes@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #attributes 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextAttributes :: (MonadIO m, IsText o) => o -> Pango.AttrList.AttrList -> m ()
setTextAttributes :: o -> AttrList -> m ()
setTextAttributes obj :: o
obj val :: AttrList
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 AttrList -> IO ()
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj "attributes" (AttrList -> Maybe AttrList
forall a. a -> Maybe a
Just AttrList
val)

-- | Construct a `GValueConstruct` with valid value for the “@attributes@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextAttributes :: (IsText o) => Pango.AttrList.AttrList -> IO (GValueConstruct o)
constructTextAttributes :: AttrList -> IO (GValueConstruct o)
constructTextAttributes val :: AttrList
val = String -> Maybe AttrList -> IO (GValueConstruct o)
forall a o.
BoxedObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed "attributes" (AttrList -> Maybe AttrList
forall a. a -> Maybe a
Just AttrList
val)

#if defined(ENABLE_OVERLOADING)
data TextAttributesPropertyInfo
instance AttrInfo TextAttributesPropertyInfo where
    type AttrAllowedOps TextAttributesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextAttributesPropertyInfo = IsText
    type AttrSetTypeConstraint TextAttributesPropertyInfo = (~) Pango.AttrList.AttrList
    type AttrTransferTypeConstraint TextAttributesPropertyInfo = (~) Pango.AttrList.AttrList
    type AttrTransferType TextAttributesPropertyInfo = Pango.AttrList.AttrList
    type AttrGetType TextAttributesPropertyInfo = (Maybe Pango.AttrList.AttrList)
    type AttrLabel TextAttributesPropertyInfo = "attributes"
    type AttrOrigin TextAttributesPropertyInfo = Text
    attrGet = getTextAttributes
    attrSet = setTextAttributes
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextAttributes
    attrClear = undefined
#endif

-- VVV Prop "buffer"
   -- Type: TInterface (Name {namespace = "Gtk", name = "EntryBuffer"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@buffer@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #buffer 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextBuffer :: (MonadIO m, IsText o, Gtk.EntryBuffer.IsEntryBuffer a) => o -> a -> m ()
setTextBuffer :: o -> a -> m ()
setTextBuffer obj :: o
obj val :: a
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 a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "buffer" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@buffer@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextBuffer :: (IsText o, Gtk.EntryBuffer.IsEntryBuffer a) => a -> IO (GValueConstruct o)
constructTextBuffer :: a -> IO (GValueConstruct o)
constructTextBuffer val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "buffer" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

#if defined(ENABLE_OVERLOADING)
data TextBufferPropertyInfo
instance AttrInfo TextBufferPropertyInfo where
    type AttrAllowedOps TextBufferPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextBufferPropertyInfo = IsText
    type AttrSetTypeConstraint TextBufferPropertyInfo = Gtk.EntryBuffer.IsEntryBuffer
    type AttrTransferTypeConstraint TextBufferPropertyInfo = Gtk.EntryBuffer.IsEntryBuffer
    type AttrTransferType TextBufferPropertyInfo = Gtk.EntryBuffer.EntryBuffer
    type AttrGetType TextBufferPropertyInfo = Gtk.EntryBuffer.EntryBuffer
    type AttrLabel TextBufferPropertyInfo = "buffer"
    type AttrOrigin TextBufferPropertyInfo = Text
    attrGet = getTextBuffer
    attrSet = setTextBuffer
    attrTransfer _ v = do
        unsafeCastTo Gtk.EntryBuffer.EntryBuffer v
    attrConstruct = constructTextBuffer
    attrClear = undefined
#endif

-- VVV Prop "enable-emoji-completion"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@enable-emoji-completion@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #enableEmojiCompletion
-- @
getTextEnableEmojiCompletion :: (MonadIO m, IsText o) => o -> m Bool
getTextEnableEmojiCompletion :: o -> m Bool
getTextEnableEmojiCompletion obj :: 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 "enable-emoji-completion"

-- | Set the value of the “@enable-emoji-completion@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #enableEmojiCompletion 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextEnableEmojiCompletion :: (MonadIO m, IsText o) => o -> Bool -> m ()
setTextEnableEmojiCompletion :: o -> Bool -> m ()
setTextEnableEmojiCompletion obj :: o
obj val :: 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 "enable-emoji-completion" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@enable-emoji-completion@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextEnableEmojiCompletion :: (IsText o) => Bool -> IO (GValueConstruct o)
constructTextEnableEmojiCompletion :: Bool -> IO (GValueConstruct o)
constructTextEnableEmojiCompletion val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "enable-emoji-completion" Bool
val

#if defined(ENABLE_OVERLOADING)
data TextEnableEmojiCompletionPropertyInfo
instance AttrInfo TextEnableEmojiCompletionPropertyInfo where
    type AttrAllowedOps TextEnableEmojiCompletionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextEnableEmojiCompletionPropertyInfo = IsText
    type AttrSetTypeConstraint TextEnableEmojiCompletionPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TextEnableEmojiCompletionPropertyInfo = (~) Bool
    type AttrTransferType TextEnableEmojiCompletionPropertyInfo = Bool
    type AttrGetType TextEnableEmojiCompletionPropertyInfo = Bool
    type AttrLabel TextEnableEmojiCompletionPropertyInfo = "enable-emoji-completion"
    type AttrOrigin TextEnableEmojiCompletionPropertyInfo = Text
    attrGet = getTextEnableEmojiCompletion
    attrSet = setTextEnableEmojiCompletion
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextEnableEmojiCompletion
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@im-module@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #imModule 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextImModule :: (MonadIO m, IsText o) => o -> T.Text -> m ()
setTextImModule :: o -> Text -> m ()
setTextImModule obj :: o
obj val :: 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 "im-module" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@im-module@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextImModule :: (IsText o) => T.Text -> IO (GValueConstruct o)
constructTextImModule :: Text -> IO (GValueConstruct o)
constructTextImModule val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "im-module" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data TextImModulePropertyInfo
instance AttrInfo TextImModulePropertyInfo where
    type AttrAllowedOps TextImModulePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TextImModulePropertyInfo = IsText
    type AttrSetTypeConstraint TextImModulePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint TextImModulePropertyInfo = (~) T.Text
    type AttrTransferType TextImModulePropertyInfo = T.Text
    type AttrGetType TextImModulePropertyInfo = (Maybe T.Text)
    type AttrLabel TextImModulePropertyInfo = "im-module"
    type AttrOrigin TextImModulePropertyInfo = Text
    attrGet = getTextImModule
    attrSet = setTextImModule
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextImModule
    attrClear = clearTextImModule
#endif

-- VVV Prop "input-hints"
   -- Type: TInterface (Name {namespace = "Gtk", name = "InputHints"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@input-hints@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #inputHints
-- @
getTextInputHints :: (MonadIO m, IsText o) => o -> m [Gtk.Flags.InputHints]
getTextInputHints :: o -> m [InputHints]
getTextInputHints obj :: o
obj = IO [InputHints] -> m [InputHints]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [InputHints] -> m [InputHints])
-> IO [InputHints] -> m [InputHints]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [InputHints]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj "input-hints"

-- | Set the value of the “@input-hints@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #inputHints 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextInputHints :: (MonadIO m, IsText o) => o -> [Gtk.Flags.InputHints] -> m ()
setTextInputHints :: o -> [InputHints] -> m ()
setTextInputHints obj :: o
obj val :: [InputHints]
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 -> [InputHints] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj "input-hints" [InputHints]
val

-- | Construct a `GValueConstruct` with valid value for the “@input-hints@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextInputHints :: (IsText o) => [Gtk.Flags.InputHints] -> IO (GValueConstruct o)
constructTextInputHints :: [InputHints] -> IO (GValueConstruct o)
constructTextInputHints val :: [InputHints]
val = String -> [InputHints] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags "input-hints" [InputHints]
val

#if defined(ENABLE_OVERLOADING)
data TextInputHintsPropertyInfo
instance AttrInfo TextInputHintsPropertyInfo where
    type AttrAllowedOps TextInputHintsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextInputHintsPropertyInfo = IsText
    type AttrSetTypeConstraint TextInputHintsPropertyInfo = (~) [Gtk.Flags.InputHints]
    type AttrTransferTypeConstraint TextInputHintsPropertyInfo = (~) [Gtk.Flags.InputHints]
    type AttrTransferType TextInputHintsPropertyInfo = [Gtk.Flags.InputHints]
    type AttrGetType TextInputHintsPropertyInfo = [Gtk.Flags.InputHints]
    type AttrLabel TextInputHintsPropertyInfo = "input-hints"
    type AttrOrigin TextInputHintsPropertyInfo = Text
    attrGet = getTextInputHints
    attrSet = setTextInputHints
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextInputHints
    attrClear = undefined
#endif

-- VVV Prop "input-purpose"
   -- Type: TInterface (Name {namespace = "Gtk", name = "InputPurpose"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@input-purpose@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #inputPurpose
-- @
getTextInputPurpose :: (MonadIO m, IsText o) => o -> m Gtk.Enums.InputPurpose
getTextInputPurpose :: o -> m InputPurpose
getTextInputPurpose obj :: o
obj = IO InputPurpose -> m InputPurpose
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputPurpose -> m InputPurpose)
-> IO InputPurpose -> m InputPurpose
forall a b. (a -> b) -> a -> b
$ o -> String -> IO InputPurpose
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "input-purpose"

-- | Set the value of the “@input-purpose@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #inputPurpose 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextInputPurpose :: (MonadIO m, IsText o) => o -> Gtk.Enums.InputPurpose -> m ()
setTextInputPurpose :: o -> InputPurpose -> m ()
setTextInputPurpose obj :: o
obj val :: InputPurpose
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 -> InputPurpose -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj "input-purpose" InputPurpose
val

-- | Construct a `GValueConstruct` with valid value for the “@input-purpose@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextInputPurpose :: (IsText o) => Gtk.Enums.InputPurpose -> IO (GValueConstruct o)
constructTextInputPurpose :: InputPurpose -> IO (GValueConstruct o)
constructTextInputPurpose val :: InputPurpose
val = String -> InputPurpose -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "input-purpose" InputPurpose
val

#if defined(ENABLE_OVERLOADING)
data TextInputPurposePropertyInfo
instance AttrInfo TextInputPurposePropertyInfo where
    type AttrAllowedOps TextInputPurposePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextInputPurposePropertyInfo = IsText
    type AttrSetTypeConstraint TextInputPurposePropertyInfo = (~) Gtk.Enums.InputPurpose
    type AttrTransferTypeConstraint TextInputPurposePropertyInfo = (~) Gtk.Enums.InputPurpose
    type AttrTransferType TextInputPurposePropertyInfo = Gtk.Enums.InputPurpose
    type AttrGetType TextInputPurposePropertyInfo = Gtk.Enums.InputPurpose
    type AttrLabel TextInputPurposePropertyInfo = "input-purpose"
    type AttrOrigin TextInputPurposePropertyInfo = Text
    attrGet = getTextInputPurpose
    attrSet = setTextInputPurpose
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextInputPurpose
    attrClear = undefined
#endif

-- VVV Prop "invisible-char"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@invisible-char@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #invisibleChar
-- @
getTextInvisibleChar :: (MonadIO m, IsText o) => o -> m Word32
getTextInvisibleChar :: o -> m Word32
getTextInvisibleChar obj :: o
obj = 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
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj "invisible-char"

-- | Set the value of the “@invisible-char@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #invisibleChar 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextInvisibleChar :: (MonadIO m, IsText o) => o -> Word32 -> m ()
setTextInvisibleChar :: o -> Word32 -> m ()
setTextInvisibleChar obj :: o
obj val :: Word32
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj "invisible-char" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@invisible-char@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextInvisibleChar :: (IsText o) => Word32 -> IO (GValueConstruct o)
constructTextInvisibleChar :: Word32 -> IO (GValueConstruct o)
constructTextInvisibleChar val :: Word32
val = String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 "invisible-char" Word32
val

#if defined(ENABLE_OVERLOADING)
data TextInvisibleCharPropertyInfo
instance AttrInfo TextInvisibleCharPropertyInfo where
    type AttrAllowedOps TextInvisibleCharPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextInvisibleCharPropertyInfo = IsText
    type AttrSetTypeConstraint TextInvisibleCharPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint TextInvisibleCharPropertyInfo = (~) Word32
    type AttrTransferType TextInvisibleCharPropertyInfo = Word32
    type AttrGetType TextInvisibleCharPropertyInfo = Word32
    type AttrLabel TextInvisibleCharPropertyInfo = "invisible-char"
    type AttrOrigin TextInvisibleCharPropertyInfo = Text
    attrGet = getTextInvisibleChar
    attrSet = setTextInvisibleChar
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextInvisibleChar
    attrClear = undefined
#endif

-- VVV Prop "invisible-char-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@invisible-char-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #invisibleCharSet
-- @
getTextInvisibleCharSet :: (MonadIO m, IsText o) => o -> m Bool
getTextInvisibleCharSet :: o -> m Bool
getTextInvisibleCharSet obj :: 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 "invisible-char-set"

-- | Set the value of the “@invisible-char-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #invisibleCharSet 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextInvisibleCharSet :: (MonadIO m, IsText o) => o -> Bool -> m ()
setTextInvisibleCharSet :: o -> Bool -> m ()
setTextInvisibleCharSet obj :: o
obj val :: 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 "invisible-char-set" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@invisible-char-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextInvisibleCharSet :: (IsText o) => Bool -> IO (GValueConstruct o)
constructTextInvisibleCharSet :: Bool -> IO (GValueConstruct o)
constructTextInvisibleCharSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "invisible-char-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data TextInvisibleCharSetPropertyInfo
instance AttrInfo TextInvisibleCharSetPropertyInfo where
    type AttrAllowedOps TextInvisibleCharSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextInvisibleCharSetPropertyInfo = IsText
    type AttrSetTypeConstraint TextInvisibleCharSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TextInvisibleCharSetPropertyInfo = (~) Bool
    type AttrTransferType TextInvisibleCharSetPropertyInfo = Bool
    type AttrGetType TextInvisibleCharSetPropertyInfo = Bool
    type AttrLabel TextInvisibleCharSetPropertyInfo = "invisible-char-set"
    type AttrOrigin TextInvisibleCharSetPropertyInfo = Text
    attrGet = getTextInvisibleCharSet
    attrSet = setTextInvisibleCharSet
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextInvisibleCharSet
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@max-length@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #maxLength 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextMaxLength :: (MonadIO m, IsText o) => o -> Int32 -> m ()
setTextMaxLength :: o -> Int32 -> m ()
setTextMaxLength obj :: o
obj val :: 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 "max-length" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@max-length@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextMaxLength :: (IsText o) => Int32 -> IO (GValueConstruct o)
constructTextMaxLength :: Int32 -> IO (GValueConstruct o)
constructTextMaxLength val :: Int32
val = String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 "max-length" Int32
val

#if defined(ENABLE_OVERLOADING)
data TextMaxLengthPropertyInfo
instance AttrInfo TextMaxLengthPropertyInfo where
    type AttrAllowedOps TextMaxLengthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextMaxLengthPropertyInfo = IsText
    type AttrSetTypeConstraint TextMaxLengthPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint TextMaxLengthPropertyInfo = (~) Int32
    type AttrTransferType TextMaxLengthPropertyInfo = Int32
    type AttrGetType TextMaxLengthPropertyInfo = Int32
    type AttrLabel TextMaxLengthPropertyInfo = "max-length"
    type AttrOrigin TextMaxLengthPropertyInfo = Text
    attrGet = getTextMaxLength
    attrSet = setTextMaxLength
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextMaxLength
    attrClear = undefined
#endif

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

-- | Get the value of the “@overwrite-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #overwriteMode
-- @
getTextOverwriteMode :: (MonadIO m, IsText o) => o -> m Bool
getTextOverwriteMode :: o -> m Bool
getTextOverwriteMode obj :: 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 "overwrite-mode"

-- | Set the value of the “@overwrite-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #overwriteMode 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextOverwriteMode :: (MonadIO m, IsText o) => o -> Bool -> m ()
setTextOverwriteMode :: o -> Bool -> m ()
setTextOverwriteMode obj :: o
obj val :: 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 "overwrite-mode" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@overwrite-mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextOverwriteMode :: (IsText o) => Bool -> IO (GValueConstruct o)
constructTextOverwriteMode :: Bool -> IO (GValueConstruct o)
constructTextOverwriteMode val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "overwrite-mode" Bool
val

#if defined(ENABLE_OVERLOADING)
data TextOverwriteModePropertyInfo
instance AttrInfo TextOverwriteModePropertyInfo where
    type AttrAllowedOps TextOverwriteModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextOverwriteModePropertyInfo = IsText
    type AttrSetTypeConstraint TextOverwriteModePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TextOverwriteModePropertyInfo = (~) Bool
    type AttrTransferType TextOverwriteModePropertyInfo = Bool
    type AttrGetType TextOverwriteModePropertyInfo = Bool
    type AttrLabel TextOverwriteModePropertyInfo = "overwrite-mode"
    type AttrOrigin TextOverwriteModePropertyInfo = Text
    attrGet = getTextOverwriteMode
    attrSet = setTextOverwriteMode
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextOverwriteMode
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@placeholder-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #placeholderText 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextPlaceholderText :: (MonadIO m, IsText o) => o -> T.Text -> m ()
setTextPlaceholderText :: o -> Text -> m ()
setTextPlaceholderText obj :: o
obj val :: 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 "placeholder-text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@placeholder-text@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextPlaceholderText :: (IsText o) => T.Text -> IO (GValueConstruct o)
constructTextPlaceholderText :: Text -> IO (GValueConstruct o)
constructTextPlaceholderText val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "placeholder-text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data TextPlaceholderTextPropertyInfo
instance AttrInfo TextPlaceholderTextPropertyInfo where
    type AttrAllowedOps TextPlaceholderTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TextPlaceholderTextPropertyInfo = IsText
    type AttrSetTypeConstraint TextPlaceholderTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint TextPlaceholderTextPropertyInfo = (~) T.Text
    type AttrTransferType TextPlaceholderTextPropertyInfo = T.Text
    type AttrGetType TextPlaceholderTextPropertyInfo = (Maybe T.Text)
    type AttrLabel TextPlaceholderTextPropertyInfo = "placeholder-text"
    type AttrOrigin TextPlaceholderTextPropertyInfo = Text
    attrGet = getTextPlaceholderText
    attrSet = setTextPlaceholderText
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextPlaceholderText
    attrClear = clearTextPlaceholderText
#endif

-- VVV Prop "populate-all"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@populate-all@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #populateAll
-- @
getTextPopulateAll :: (MonadIO m, IsText o) => o -> m Bool
getTextPopulateAll :: o -> m Bool
getTextPopulateAll obj :: 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 "populate-all"

-- | Set the value of the “@populate-all@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #populateAll 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextPopulateAll :: (MonadIO m, IsText o) => o -> Bool -> m ()
setTextPopulateAll :: o -> Bool -> m ()
setTextPopulateAll obj :: o
obj val :: 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 "populate-all" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@populate-all@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextPopulateAll :: (IsText o) => Bool -> IO (GValueConstruct o)
constructTextPopulateAll :: Bool -> IO (GValueConstruct o)
constructTextPopulateAll val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "populate-all" Bool
val

#if defined(ENABLE_OVERLOADING)
data TextPopulateAllPropertyInfo
instance AttrInfo TextPopulateAllPropertyInfo where
    type AttrAllowedOps TextPopulateAllPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextPopulateAllPropertyInfo = IsText
    type AttrSetTypeConstraint TextPopulateAllPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TextPopulateAllPropertyInfo = (~) Bool
    type AttrTransferType TextPopulateAllPropertyInfo = Bool
    type AttrGetType TextPopulateAllPropertyInfo = Bool
    type AttrLabel TextPopulateAllPropertyInfo = "populate-all"
    type AttrOrigin TextPopulateAllPropertyInfo = Text
    attrGet = getTextPopulateAll
    attrSet = setTextPopulateAll
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextPopulateAll
    attrClear = undefined
#endif

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

-- | Get the value of the “@propagate-text-width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #propagateTextWidth
-- @
getTextPropagateTextWidth :: (MonadIO m, IsText o) => o -> m Bool
getTextPropagateTextWidth :: o -> m Bool
getTextPropagateTextWidth obj :: 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 "propagate-text-width"

-- | Set the value of the “@propagate-text-width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #propagateTextWidth 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextPropagateTextWidth :: (MonadIO m, IsText o) => o -> Bool -> m ()
setTextPropagateTextWidth :: o -> Bool -> m ()
setTextPropagateTextWidth obj :: o
obj val :: 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 "propagate-text-width" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@propagate-text-width@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextPropagateTextWidth :: (IsText o) => Bool -> IO (GValueConstruct o)
constructTextPropagateTextWidth :: Bool -> IO (GValueConstruct o)
constructTextPropagateTextWidth val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "propagate-text-width" Bool
val

#if defined(ENABLE_OVERLOADING)
data TextPropagateTextWidthPropertyInfo
instance AttrInfo TextPropagateTextWidthPropertyInfo where
    type AttrAllowedOps TextPropagateTextWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextPropagateTextWidthPropertyInfo = IsText
    type AttrSetTypeConstraint TextPropagateTextWidthPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TextPropagateTextWidthPropertyInfo = (~) Bool
    type AttrTransferType TextPropagateTextWidthPropertyInfo = Bool
    type AttrGetType TextPropagateTextWidthPropertyInfo = Bool
    type AttrLabel TextPropagateTextWidthPropertyInfo = "propagate-text-width"
    type AttrOrigin TextPropagateTextWidthPropertyInfo = Text
    attrGet = getTextPropagateTextWidth
    attrSet = setTextPropagateTextWidth
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextPropagateTextWidth
    attrClear = undefined
#endif

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

-- | Get the value of the “@scroll-offset@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #scrollOffset
-- @
getTextScrollOffset :: (MonadIO m, IsText o) => o -> m Int32
getTextScrollOffset :: o -> m Int32
getTextScrollOffset obj :: 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 "scroll-offset"

#if defined(ENABLE_OVERLOADING)
data TextScrollOffsetPropertyInfo
instance AttrInfo TextScrollOffsetPropertyInfo where
    type AttrAllowedOps TextScrollOffsetPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint TextScrollOffsetPropertyInfo = IsText
    type AttrSetTypeConstraint TextScrollOffsetPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TextScrollOffsetPropertyInfo = (~) ()
    type AttrTransferType TextScrollOffsetPropertyInfo = ()
    type AttrGetType TextScrollOffsetPropertyInfo = Int32
    type AttrLabel TextScrollOffsetPropertyInfo = "scroll-offset"
    type AttrOrigin TextScrollOffsetPropertyInfo = Text
    attrGet = getTextScrollOffset
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "tabs"
   -- Type: TInterface (Name {namespace = "Pango", name = "TabArray"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@tabs@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #tabs 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextTabs :: (MonadIO m, IsText o) => o -> Pango.TabArray.TabArray -> m ()
setTextTabs :: o -> TabArray -> m ()
setTextTabs obj :: o
obj val :: TabArray
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 TabArray -> IO ()
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj "tabs" (TabArray -> Maybe TabArray
forall a. a -> Maybe a
Just TabArray
val)

-- | Construct a `GValueConstruct` with valid value for the “@tabs@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextTabs :: (IsText o) => Pango.TabArray.TabArray -> IO (GValueConstruct o)
constructTextTabs :: TabArray -> IO (GValueConstruct o)
constructTextTabs val :: TabArray
val = String -> Maybe TabArray -> IO (GValueConstruct o)
forall a o.
BoxedObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed "tabs" (TabArray -> Maybe TabArray
forall a. a -> Maybe a
Just TabArray
val)

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

#if defined(ENABLE_OVERLOADING)
data TextTabsPropertyInfo
instance AttrInfo TextTabsPropertyInfo where
    type AttrAllowedOps TextTabsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TextTabsPropertyInfo = IsText
    type AttrSetTypeConstraint TextTabsPropertyInfo = (~) Pango.TabArray.TabArray
    type AttrTransferTypeConstraint TextTabsPropertyInfo = (~) Pango.TabArray.TabArray
    type AttrTransferType TextTabsPropertyInfo = Pango.TabArray.TabArray
    type AttrGetType TextTabsPropertyInfo = (Maybe Pango.TabArray.TabArray)
    type AttrLabel TextTabsPropertyInfo = "tabs"
    type AttrOrigin TextTabsPropertyInfo = Text
    attrGet = getTextTabs
    attrSet = setTextTabs
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextTabs
    attrClear = clearTextTabs
#endif

-- VVV Prop "truncate-multiline"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@truncate-multiline@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #truncateMultiline
-- @
getTextTruncateMultiline :: (MonadIO m, IsText o) => o -> m Bool
getTextTruncateMultiline :: o -> m Bool
getTextTruncateMultiline obj :: 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 "truncate-multiline"

-- | Set the value of the “@truncate-multiline@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #truncateMultiline 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextTruncateMultiline :: (MonadIO m, IsText o) => o -> Bool -> m ()
setTextTruncateMultiline :: o -> Bool -> m ()
setTextTruncateMultiline obj :: o
obj val :: 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 "truncate-multiline" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@truncate-multiline@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextTruncateMultiline :: (IsText o) => Bool -> IO (GValueConstruct o)
constructTextTruncateMultiline :: Bool -> IO (GValueConstruct o)
constructTextTruncateMultiline val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "truncate-multiline" Bool
val

#if defined(ENABLE_OVERLOADING)
data TextTruncateMultilinePropertyInfo
instance AttrInfo TextTruncateMultilinePropertyInfo where
    type AttrAllowedOps TextTruncateMultilinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextTruncateMultilinePropertyInfo = IsText
    type AttrSetTypeConstraint TextTruncateMultilinePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TextTruncateMultilinePropertyInfo = (~) Bool
    type AttrTransferType TextTruncateMultilinePropertyInfo = Bool
    type AttrGetType TextTruncateMultilinePropertyInfo = Bool
    type AttrLabel TextTruncateMultilinePropertyInfo = "truncate-multiline"
    type AttrOrigin TextTruncateMultilinePropertyInfo = Text
    attrGet = getTextTruncateMultiline
    attrSet = setTextTruncateMultiline
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextTruncateMultiline
    attrClear = undefined
#endif

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

-- | Get the value of the “@visibility@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' text #visibility
-- @
getTextVisibility :: (MonadIO m, IsText o) => o -> m Bool
getTextVisibility :: o -> m Bool
getTextVisibility obj :: 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 "visibility"

-- | Set the value of the “@visibility@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #visibility 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextVisibility :: (MonadIO m, IsText o) => o -> Bool -> m ()
setTextVisibility :: o -> Bool -> m ()
setTextVisibility obj :: o
obj val :: 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 "visibility" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@visibility@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextVisibility :: (IsText o) => Bool -> IO (GValueConstruct o)
constructTextVisibility :: Bool -> IO (GValueConstruct o)
constructTextVisibility val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "visibility" Bool
val

#if defined(ENABLE_OVERLOADING)
data TextVisibilityPropertyInfo
instance AttrInfo TextVisibilityPropertyInfo where
    type AttrAllowedOps TextVisibilityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextVisibilityPropertyInfo = IsText
    type AttrSetTypeConstraint TextVisibilityPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TextVisibilityPropertyInfo = (~) Bool
    type AttrTransferType TextVisibilityPropertyInfo = Bool
    type AttrGetType TextVisibilityPropertyInfo = Bool
    type AttrLabel TextVisibilityPropertyInfo = "visibility"
    type AttrOrigin TextVisibilityPropertyInfo = Text
    attrGet = getTextVisibility
    attrSet = setTextVisibility
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextVisibility
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Text
type instance O.AttributeList Text = TextAttributeList
type TextAttributeList = ('[ '("activatesDefault", TextActivatesDefaultPropertyInfo), '("attributes", TextAttributesPropertyInfo), '("buffer", TextBufferPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("cursorPosition", Gtk.Editable.EditableCursorPositionPropertyInfo), '("editable", Gtk.Editable.EditableEditablePropertyInfo), '("enableEmojiCompletion", TextEnableEmojiCompletionPropertyInfo), '("expand", Gtk.Widget.WidgetExpandPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("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), '("imModule", TextImModulePropertyInfo), '("inputHints", TextInputHintsPropertyInfo), '("inputPurpose", TextInputPurposePropertyInfo), '("invisibleChar", TextInvisibleCharPropertyInfo), '("invisibleCharSet", TextInvisibleCharSetPropertyInfo), '("isFocus", Gtk.Widget.WidgetIsFocusPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("margin", Gtk.Widget.WidgetMarginPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("maxLength", TextMaxLengthPropertyInfo), '("maxWidthChars", Gtk.Editable.EditableMaxWidthCharsPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("overwriteMode", TextOverwriteModePropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("placeholderText", TextPlaceholderTextPropertyInfo), '("populateAll", TextPopulateAllPropertyInfo), '("propagateTextWidth", TextPropagateTextWidthPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("scrollOffset", TextScrollOffsetPropertyInfo), '("selectionBound", Gtk.Editable.EditableSelectionBoundPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("surface", Gtk.Widget.WidgetSurfacePropertyInfo), '("tabs", TextTabsPropertyInfo), '("text", Gtk.Editable.EditableTextPropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("truncateMultiline", TextTruncateMultilinePropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visibility", TextVisibilityPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthChars", Gtk.Editable.EditableWidthCharsPropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo), '("xalign", Gtk.Editable.EditableXalignPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
textActivatesDefault :: AttrLabelProxy "activatesDefault"
textActivatesDefault = AttrLabelProxy

textAttributes :: AttrLabelProxy "attributes"
textAttributes = AttrLabelProxy

textBuffer :: AttrLabelProxy "buffer"
textBuffer = AttrLabelProxy

textEnableEmojiCompletion :: AttrLabelProxy "enableEmojiCompletion"
textEnableEmojiCompletion = AttrLabelProxy

textImModule :: AttrLabelProxy "imModule"
textImModule = AttrLabelProxy

textInputHints :: AttrLabelProxy "inputHints"
textInputHints = AttrLabelProxy

textInputPurpose :: AttrLabelProxy "inputPurpose"
textInputPurpose = AttrLabelProxy

textInvisibleChar :: AttrLabelProxy "invisibleChar"
textInvisibleChar = AttrLabelProxy

textInvisibleCharSet :: AttrLabelProxy "invisibleCharSet"
textInvisibleCharSet = AttrLabelProxy

textMaxLength :: AttrLabelProxy "maxLength"
textMaxLength = AttrLabelProxy

textOverwriteMode :: AttrLabelProxy "overwriteMode"
textOverwriteMode = AttrLabelProxy

textPlaceholderText :: AttrLabelProxy "placeholderText"
textPlaceholderText = AttrLabelProxy

textPopulateAll :: AttrLabelProxy "populateAll"
textPopulateAll = AttrLabelProxy

textPropagateTextWidth :: AttrLabelProxy "propagateTextWidth"
textPropagateTextWidth = AttrLabelProxy

textScrollOffset :: AttrLabelProxy "scrollOffset"
textScrollOffset = AttrLabelProxy

textTabs :: AttrLabelProxy "tabs"
textTabs = AttrLabelProxy

textTruncateMultiline :: AttrLabelProxy "truncateMultiline"
textTruncateMultiline = AttrLabelProxy

textVisibility :: AttrLabelProxy "visibility"
textVisibility = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Text = TextSignalList
type TextSignalList = ('[ '("accelClosuresChanged", Gtk.Widget.WidgetAccelClosuresChangedSignalInfo), '("activate", TextActivateSignalInfo), '("backspace", TextBackspaceSignalInfo), '("canActivateAccel", Gtk.Widget.WidgetCanActivateAccelSignalInfo), '("changed", Gtk.Editable.EditableChangedSignalInfo), '("copyClipboard", TextCopyClipboardSignalInfo), '("cutClipboard", TextCutClipboardSignalInfo), '("deleteFromCursor", TextDeleteFromCursorSignalInfo), '("deleteText", Gtk.Editable.EditableDeleteTextSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("dragBegin", Gtk.Widget.WidgetDragBeginSignalInfo), '("dragDataDelete", Gtk.Widget.WidgetDragDataDeleteSignalInfo), '("dragDataGet", Gtk.Widget.WidgetDragDataGetSignalInfo), '("dragDataReceived", Gtk.Widget.WidgetDragDataReceivedSignalInfo), '("dragDrop", Gtk.Widget.WidgetDragDropSignalInfo), '("dragEnd", Gtk.Widget.WidgetDragEndSignalInfo), '("dragFailed", Gtk.Widget.WidgetDragFailedSignalInfo), '("dragLeave", Gtk.Widget.WidgetDragLeaveSignalInfo), '("dragMotion", Gtk.Widget.WidgetDragMotionSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("insertAtCursor", TextInsertAtCursorSignalInfo), '("insertEmoji", TextInsertEmojiSignalInfo), '("insertText", Gtk.Editable.EditableInsertTextSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveCursor", TextMoveCursorSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("pasteClipboard", TextPasteClipboardSignalInfo), '("populatePopup", TextPopulatePopupSignalInfo), '("popupMenu", Gtk.Widget.WidgetPopupMenuSignalInfo), '("preeditChanged", TextPreeditChangedSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("sizeAllocate", Gtk.Widget.WidgetSizeAllocateSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("styleUpdated", Gtk.Widget.WidgetStyleUpdatedSignalInfo), '("toggleOverwrite", TextToggleOverwriteSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_text_new" gtk_text_new :: 
    IO (Ptr Text)

-- | Creates a new self.
textNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Text
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Text.Text'.
textNew :: m Text
textNew  = 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 Text
result <- IO (Ptr Text)
gtk_text_new
    Text -> Ptr Text -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "textNew" Ptr Text
result
    Text
result' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
Text) Ptr Text
result
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Text::new_with_buffer
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The buffer to use for the new #GtkText."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Text" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_new_with_buffer" gtk_text_new_with_buffer :: 
    Ptr Gtk.EntryBuffer.EntryBuffer ->      -- buffer : TInterface (Name {namespace = "Gtk", name = "EntryBuffer"})
    IO (Ptr Text)

-- | Creates a new self with the specified text buffer.
textNewWithBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.EntryBuffer.IsEntryBuffer a) =>
    a
    -- ^ /@buffer@/: The buffer to use for the new t'GI.Gtk.Objects.Text.Text'.
    -> m Text
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Text.Text'
textNewWithBuffer :: a -> m Text
textNewWithBuffer buffer :: a
buffer = 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 EntryBuffer
buffer' <- a -> IO (Ptr EntryBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr Text
result <- Ptr EntryBuffer -> IO (Ptr Text)
gtk_text_new_with_buffer Ptr EntryBuffer
buffer'
    Text -> Ptr Text -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "textNewWithBuffer" Ptr Text
result
    Text
result' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
Text) Ptr Text
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_text_get_activates_default" gtk_text_get_activates_default :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO CInt

-- | Retrieves the value set by 'GI.Gtk.Objects.Text.textSetActivatesDefault'.
textGetActivatesDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the self will activate the default widget
textGetActivatesDefault :: a -> m Bool
textGetActivatesDefault self :: a
self = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Text -> IO CInt
gtk_text_get_activates_default Ptr Text
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextGetActivatesDefaultMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsText a) => O.MethodInfo TextGetActivatesDefaultMethodInfo a signature where
    overloadedMethod = textGetActivatesDefault

#endif

-- method Text::get_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "AttrList" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_get_attributes" gtk_text_get_attributes :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO (Ptr Pango.AttrList.AttrList)

-- | Gets the attribute list that was set on the self using
-- 'GI.Gtk.Objects.Text.textSetAttributes', if any.
textGetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m (Maybe Pango.AttrList.AttrList)
    -- ^ __Returns:__ the attribute list, or 'P.Nothing'
    --     if none was set.
textGetAttributes :: a -> m (Maybe AttrList)
textGetAttributes self :: a
self = IO (Maybe AttrList) -> m (Maybe AttrList)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AttrList) -> m (Maybe AttrList))
-> IO (Maybe AttrList) -> m (Maybe AttrList)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AttrList
result <- Ptr Text -> IO (Ptr AttrList)
gtk_text_get_attributes Ptr Text
self'
    Maybe AttrList
maybeResult <- Ptr AttrList
-> (Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr AttrList
result ((Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList))
-> (Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr AttrList
result' -> do
        AttrList
result'' <- ((ManagedPtr AttrList -> AttrList) -> Ptr AttrList -> IO AttrList
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr AttrList -> AttrList
Pango.AttrList.AttrList) Ptr AttrList
result'
        AttrList -> IO AttrList
forall (m :: * -> *) a. Monad m => a -> m a
return AttrList
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe AttrList -> IO (Maybe AttrList)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AttrList
maybeResult

#if defined(ENABLE_OVERLOADING)
data TextGetAttributesMethodInfo
instance (signature ~ (m (Maybe Pango.AttrList.AttrList)), MonadIO m, IsText a) => O.MethodInfo TextGetAttributesMethodInfo a signature where
    overloadedMethod = textGetAttributes

#endif

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

foreign import ccall "gtk_text_get_buffer" gtk_text_get_buffer :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO (Ptr Gtk.EntryBuffer.EntryBuffer)

-- | Get the t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' object which holds the text for
-- this self.
textGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m Gtk.EntryBuffer.EntryBuffer
    -- ^ __Returns:__ A t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' object.
textGetBuffer :: a -> m EntryBuffer
textGetBuffer self :: a
self = IO EntryBuffer -> m EntryBuffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntryBuffer -> m EntryBuffer)
-> IO EntryBuffer -> m EntryBuffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr EntryBuffer
result <- Ptr Text -> IO (Ptr EntryBuffer)
gtk_text_get_buffer Ptr Text
self'
    Text -> Ptr EntryBuffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "textGetBuffer" Ptr EntryBuffer
result
    EntryBuffer
result' <- ((ManagedPtr EntryBuffer -> EntryBuffer)
-> Ptr EntryBuffer -> IO EntryBuffer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr EntryBuffer -> EntryBuffer
Gtk.EntryBuffer.EntryBuffer) Ptr EntryBuffer
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    EntryBuffer -> IO EntryBuffer
forall (m :: * -> *) a. Monad m => a -> m a
return EntryBuffer
result'

#if defined(ENABLE_OVERLOADING)
data TextGetBufferMethodInfo
instance (signature ~ (m Gtk.EntryBuffer.EntryBuffer), MonadIO m, IsText a) => O.MethodInfo TextGetBufferMethodInfo a signature where
    overloadedMethod = textGetBuffer

#endif

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

foreign import ccall "gtk_text_get_input_hints" gtk_text_get_input_hints :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO CUInt

-- | Gets the value of the t'GI.Gtk.Objects.Text.Text':@/input-hints/@ property.
textGetInputHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m [Gtk.Flags.InputHints]
textGetInputHints :: a -> m [InputHints]
textGetInputHints self :: a
self = IO [InputHints] -> m [InputHints]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [InputHints] -> m [InputHints])
-> IO [InputHints] -> m [InputHints]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Text -> IO CUInt
gtk_text_get_input_hints Ptr Text
self'
    let result' :: [InputHints]
result' = CUInt -> [InputHints]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [InputHints] -> IO [InputHints]
forall (m :: * -> *) a. Monad m => a -> m a
return [InputHints]
result'

#if defined(ENABLE_OVERLOADING)
data TextGetInputHintsMethodInfo
instance (signature ~ (m [Gtk.Flags.InputHints]), MonadIO m, IsText a) => O.MethodInfo TextGetInputHintsMethodInfo a signature where
    overloadedMethod = textGetInputHints

#endif

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

foreign import ccall "gtk_text_get_input_purpose" gtk_text_get_input_purpose :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO CUInt

-- | Gets the value of the t'GI.Gtk.Objects.Text.Text':@/input-purpose/@ property.
textGetInputPurpose ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m Gtk.Enums.InputPurpose
textGetInputPurpose :: a -> m InputPurpose
textGetInputPurpose self :: a
self = IO InputPurpose -> m InputPurpose
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputPurpose -> m InputPurpose)
-> IO InputPurpose -> m InputPurpose
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Text -> IO CUInt
gtk_text_get_input_purpose Ptr Text
self'
    let result' :: InputPurpose
result' = (Int -> InputPurpose
forall a. Enum a => Int -> a
toEnum (Int -> InputPurpose) -> (CUInt -> Int) -> CUInt -> InputPurpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    InputPurpose -> IO InputPurpose
forall (m :: * -> *) a. Monad m => a -> m a
return InputPurpose
result'

#if defined(ENABLE_OVERLOADING)
data TextGetInputPurposeMethodInfo
instance (signature ~ (m Gtk.Enums.InputPurpose), MonadIO m, IsText a) => O.MethodInfo TextGetInputPurposeMethodInfo a signature where
    overloadedMethod = textGetInputPurpose

#endif

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

foreign import ccall "gtk_text_get_invisible_char" gtk_text_get_invisible_char :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO CInt

-- | Retrieves the character displayed in place of the real characters
-- for entries with visibility set to false.
-- See 'GI.Gtk.Objects.Text.textSetInvisibleChar'.
textGetInvisibleChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m Char
    -- ^ __Returns:__ the current invisible char, or 0, if the self does not
    --               show invisible text at all.
textGetInvisibleChar :: a -> m Char
textGetInvisibleChar self :: a
self = IO Char -> m Char
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Char -> m Char) -> IO Char -> m Char
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Text -> IO CInt
gtk_text_get_invisible_char Ptr Text
self'
    let result' :: Char
result' = (Int -> Char
chr (Int -> Char) -> (CInt -> Int) -> CInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Char -> IO Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
result'

#if defined(ENABLE_OVERLOADING)
data TextGetInvisibleCharMethodInfo
instance (signature ~ (m Char), MonadIO m, IsText a) => O.MethodInfo TextGetInvisibleCharMethodInfo a signature where
    overloadedMethod = textGetInvisibleChar

#endif

-- method Text::get_max_length
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , 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_text_get_max_length" gtk_text_get_max_length :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO Int32

-- | Retrieves the maximum allowed length of the text in
-- /@self@/. See 'GI.Gtk.Objects.Text.textSetMaxLength'.
-- 
-- This is equivalent to getting /@self@/\'s t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' and
-- calling 'GI.Gtk.Objects.EntryBuffer.entryBufferGetMaxLength' on it.
textGetMaxLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m Int32
    -- ^ __Returns:__ the maximum allowed number of characters
    --               in t'GI.Gtk.Objects.Text.Text', or 0 if there is no maximum.
textGetMaxLength :: a -> m Int32
textGetMaxLength self :: a
self = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr Text -> IO Int32
gtk_text_get_max_length Ptr Text
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TextGetMaxLengthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsText a) => O.MethodInfo TextGetMaxLengthMethodInfo a signature where
    overloadedMethod = textGetMaxLength

#endif

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

foreign import ccall "gtk_text_get_overwrite_mode" gtk_text_get_overwrite_mode :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO CInt

-- | Gets the value set by 'GI.Gtk.Objects.Text.textSetOverwriteMode'.
textGetOverwriteMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m Bool
    -- ^ __Returns:__ whether the text is overwritten when typing.
textGetOverwriteMode :: a -> m Bool
textGetOverwriteMode self :: a
self = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Text -> IO CInt
gtk_text_get_overwrite_mode Ptr Text
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextGetOverwriteModeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsText a) => O.MethodInfo TextGetOverwriteModeMethodInfo a signature where
    overloadedMethod = textGetOverwriteMode

#endif

-- method Text::get_placeholder_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , 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_text_get_placeholder_text" gtk_text_get_placeholder_text :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO CString

-- | Retrieves the text that will be displayed when /@self@/ is empty and unfocused
textGetPlaceholderText ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a pointer to the placeholder text as a string.
    --   This string points to internally allocated storage in the widget and must
    --   not be freed, modified or stored. If no placeholder text has been set,
    --   'P.Nothing' will be returned.
textGetPlaceholderText :: a -> m (Maybe Text)
textGetPlaceholderText self :: a
self = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Text -> IO CString
gtk_text_get_placeholder_text Ptr Text
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data TextGetPlaceholderTextMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsText a) => O.MethodInfo TextGetPlaceholderTextMethodInfo a signature where
    overloadedMethod = textGetPlaceholderText

#endif

-- method Text::get_tabs
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "TabArray" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_get_tabs" gtk_text_get_tabs :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO (Ptr Pango.TabArray.TabArray)

-- | Gets the tabstops that were set on the self using 'GI.Gtk.Objects.Text.textSetTabs', if
-- any.
textGetTabs ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m (Maybe Pango.TabArray.TabArray)
    -- ^ __Returns:__ the tabstops, or 'P.Nothing' if none was set.
textGetTabs :: a -> m (Maybe TabArray)
textGetTabs self :: a
self = IO (Maybe TabArray) -> m (Maybe TabArray)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TabArray) -> m (Maybe TabArray))
-> IO (Maybe TabArray) -> m (Maybe TabArray)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TabArray
result <- Ptr Text -> IO (Ptr TabArray)
gtk_text_get_tabs Ptr Text
self'
    Maybe TabArray
maybeResult <- Ptr TabArray
-> (Ptr TabArray -> IO TabArray) -> IO (Maybe TabArray)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TabArray
result ((Ptr TabArray -> IO TabArray) -> IO (Maybe TabArray))
-> (Ptr TabArray -> IO TabArray) -> IO (Maybe TabArray)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr TabArray
result' -> do
        TabArray
result'' <- ((ManagedPtr TabArray -> TabArray) -> Ptr TabArray -> IO TabArray
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TabArray -> TabArray
Pango.TabArray.TabArray) Ptr TabArray
result'
        TabArray -> IO TabArray
forall (m :: * -> *) a. Monad m => a -> m a
return TabArray
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe TabArray -> IO (Maybe TabArray)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TabArray
maybeResult

#if defined(ENABLE_OVERLOADING)
data TextGetTabsMethodInfo
instance (signature ~ (m (Maybe Pango.TabArray.TabArray)), MonadIO m, IsText a) => O.MethodInfo TextGetTabsMethodInfo a signature where
    overloadedMethod = textGetTabs

#endif

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

foreign import ccall "gtk_text_get_text_length" gtk_text_get_text_length :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO Word16

-- | Retrieves the current length of the text in
-- /@self@/.
-- 
-- This is equivalent to getting /@self@/\'s t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' and
-- calling 'GI.Gtk.Objects.EntryBuffer.entryBufferGetLength' on it.
textGetTextLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m Word16
    -- ^ __Returns:__ the current number of characters
    --               in t'GI.Gtk.Objects.Text.Text', or 0 if there are none.
textGetTextLength :: a -> m Word16
textGetTextLength self :: a
self = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word16
result <- Ptr Text -> IO Word16
gtk_text_get_text_length Ptr Text
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data TextGetTextLengthMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsText a) => O.MethodInfo TextGetTextLengthMethodInfo a signature where
    overloadedMethod = textGetTextLength

#endif

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

foreign import ccall "gtk_text_get_visibility" gtk_text_get_visibility :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO CInt

-- | Retrieves whether the text in /@self@/ is visible.
-- See 'GI.Gtk.Objects.Text.textSetVisibility'.
textGetVisibility ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the text is currently visible
textGetVisibility :: a -> m Bool
textGetVisibility self :: a
self = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Text -> IO CInt
gtk_text_get_visibility Ptr Text
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextGetVisibilityMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsText a) => O.MethodInfo TextGetVisibilityMethodInfo a signature where
    overloadedMethod = textGetVisibility

#endif

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

foreign import ccall "gtk_text_grab_focus_without_selecting" gtk_text_grab_focus_without_selecting :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO ()

-- | Causes /@self@/ to have keyboard focus.
-- 
-- It behaves like 'GI.Gtk.Objects.Widget.widgetGrabFocus',
-- except that it doesn\'t select the contents of the self.
-- You only want to call this on some special entries
-- which the user usually doesn\'t want to replace all text in,
-- such as search-as-you-type entries.
textGrabFocusWithoutSelecting ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m ()
textGrabFocusWithoutSelecting :: a -> m ()
textGrabFocusWithoutSelecting self :: a
self = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Text -> IO ()
gtk_text_grab_focus_without_selecting Ptr Text
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextGrabFocusWithoutSelectingMethodInfo
instance (signature ~ (m ()), MonadIO m, IsText a) => O.MethodInfo TextGrabFocusWithoutSelectingMethodInfo a signature where
    overloadedMethod = textGrabFocusWithoutSelecting

#endif

-- method Text::set_activates_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "activates"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%TRUE to activate window\8217s default widget on Enter keypress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_set_activates_default" gtk_text_set_activates_default :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    CInt ->                                 -- activates : TBasicType TBoolean
    IO ()

-- | If /@activates@/ is 'P.True', pressing Enter in the /@self@/ will activate the default
-- widget for the window containing the self. This usually means that
-- the dialog box containing the self will be closed, since the default
-- widget is usually one of the dialog buttons.
textSetActivatesDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> Bool
    -- ^ /@activates@/: 'P.True' to activate window’s default widget on Enter keypress
    -> m ()
textSetActivatesDefault :: a -> Bool -> m ()
textSetActivatesDefault self :: a
self activates :: Bool
activates = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let activates' :: CInt
activates' = (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
activates
    Ptr Text -> CInt -> IO ()
gtk_text_set_activates_default Ptr Text
self' CInt
activates'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetActivatesDefaultMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsText a) => O.MethodInfo TextSetActivatesDefaultMethodInfo a signature where
    overloadedMethod = textSetActivatesDefault

#endif

-- method Text::set_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attrs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoAttrList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_set_attributes" gtk_text_set_attributes :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    Ptr Pango.AttrList.AttrList ->          -- attrs : TInterface (Name {namespace = "Pango", name = "AttrList"})
    IO ()

-- | Sets a t'GI.Pango.Structs.AttrList.AttrList'; the attributes in the list are applied to the
-- self text.
textSetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> Pango.AttrList.AttrList
    -- ^ /@attrs@/: a t'GI.Pango.Structs.AttrList.AttrList'
    -> m ()
textSetAttributes :: a -> AttrList -> m ()
textSetAttributes self :: a
self attrs :: AttrList
attrs = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AttrList
attrs' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
attrs
    Ptr Text -> Ptr AttrList -> IO ()
gtk_text_set_attributes Ptr Text
self' Ptr AttrList
attrs'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
attrs
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetAttributesMethodInfo
instance (signature ~ (Pango.AttrList.AttrList -> m ()), MonadIO m, IsText a) => O.MethodInfo TextSetAttributesMethodInfo a signature where
    overloadedMethod = textSetAttributes

#endif

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

foreign import ccall "gtk_text_set_buffer" gtk_text_set_buffer :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    Ptr Gtk.EntryBuffer.EntryBuffer ->      -- buffer : TInterface (Name {namespace = "Gtk", name = "EntryBuffer"})
    IO ()

-- | Set the t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' object which holds the text for
-- this widget.
textSetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a, Gtk.EntryBuffer.IsEntryBuffer b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> b
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.EntryBuffer.EntryBuffer'
    -> m ()
textSetBuffer :: a -> b -> m ()
textSetBuffer self :: a
self buffer :: b
buffer = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr EntryBuffer
buffer' <- b -> IO (Ptr EntryBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
buffer
    Ptr Text -> Ptr EntryBuffer -> IO ()
gtk_text_set_buffer Ptr Text
self' Ptr EntryBuffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
buffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetBufferMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsText a, Gtk.EntryBuffer.IsEntryBuffer b) => O.MethodInfo TextSetBufferMethodInfo a signature where
    overloadedMethod = textSetBuffer

#endif

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

foreign import ccall "gtk_text_set_input_hints" gtk_text_set_input_hints :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    CUInt ->                                -- hints : TInterface (Name {namespace = "Gtk", name = "InputHints"})
    IO ()

-- | Sets the t'GI.Gtk.Objects.Text.Text':@/input-hints/@ property, which
-- allows input methods to fine-tune their behaviour.
textSetInputHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> [Gtk.Flags.InputHints]
    -- ^ /@hints@/: the hints
    -> m ()
textSetInputHints :: a -> [InputHints] -> m ()
textSetInputHints self :: a
self hints :: [InputHints]
hints = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let hints' :: CUInt
hints' = [InputHints] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [InputHints]
hints
    Ptr Text -> CUInt -> IO ()
gtk_text_set_input_hints Ptr Text
self' CUInt
hints'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetInputHintsMethodInfo
instance (signature ~ ([Gtk.Flags.InputHints] -> m ()), MonadIO m, IsText a) => O.MethodInfo TextSetInputHintsMethodInfo a signature where
    overloadedMethod = textSetInputHints

#endif

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

foreign import ccall "gtk_text_set_input_purpose" gtk_text_set_input_purpose :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    CUInt ->                                -- purpose : TInterface (Name {namespace = "Gtk", name = "InputPurpose"})
    IO ()

-- | Sets the t'GI.Gtk.Objects.Text.Text':@/input-purpose/@ property which
-- can be used by on-screen keyboards and other input
-- methods to adjust their behaviour.
textSetInputPurpose ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> Gtk.Enums.InputPurpose
    -- ^ /@purpose@/: the purpose
    -> m ()
textSetInputPurpose :: a -> InputPurpose -> m ()
textSetInputPurpose self :: a
self purpose :: InputPurpose
purpose = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let purpose' :: CUInt
purpose' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (InputPurpose -> Int) -> InputPurpose -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputPurpose -> Int
forall a. Enum a => a -> Int
fromEnum) InputPurpose
purpose
    Ptr Text -> CUInt -> IO ()
gtk_text_set_input_purpose Ptr Text
self' CUInt
purpose'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetInputPurposeMethodInfo
instance (signature ~ (Gtk.Enums.InputPurpose -> m ()), MonadIO m, IsText a) => O.MethodInfo TextSetInputPurposeMethodInfo a signature where
    overloadedMethod = textSetInputPurpose

#endif

-- method Text::set_invisible_char
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ch"
--           , argType = TBasicType TUniChar
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a Unicode character"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_set_invisible_char" gtk_text_set_invisible_char :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    CInt ->                                 -- ch : TBasicType TUniChar
    IO ()

-- | Sets the character to use in place of the actual text when
-- 'GI.Gtk.Objects.Text.textSetVisibility' has been called to set text visibility
-- to 'P.False'. i.e. this is the character used in “password mode” to
-- show the user how many characters have been typed.
-- 
-- By default, GTK picks the best invisible char available in the
-- current font. If you set the invisible char to 0, then the user
-- will get no feedback at all; there will be no text on the screen
-- as they type.
textSetInvisibleChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> Char
    -- ^ /@ch@/: a Unicode character
    -> m ()
textSetInvisibleChar :: a -> Char -> m ()
textSetInvisibleChar self :: a
self ch :: Char
ch = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let ch' :: CInt
ch' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) Char
ch
    Ptr Text -> CInt -> IO ()
gtk_text_set_invisible_char Ptr Text
self' CInt
ch'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetInvisibleCharMethodInfo
instance (signature ~ (Char -> m ()), MonadIO m, IsText a) => O.MethodInfo TextSetInvisibleCharMethodInfo a signature where
    overloadedMethod = textSetInvisibleChar

#endif

-- method Text::set_max_length
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , 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 maximum length of the self, or 0 for no maximum.\n  (other than the maximum length of entries.) The value passed in will\n  be clamped to the range 0-65536."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_set_max_length" gtk_text_set_max_length :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    Int32 ->                                -- length : TBasicType TInt
    IO ()

-- | Sets the maximum allowed length of the contents of the widget.
-- 
-- If the current contents are longer than the given length, then
-- they will be truncated to fit.
-- 
-- This is equivalent to getting /@self@/\'s t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' and
-- calling 'GI.Gtk.Objects.EntryBuffer.entryBufferSetMaxLength' on it.
-- ]|
textSetMaxLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> Int32
    -- ^ /@length@/: the maximum length of the self, or 0 for no maximum.
    --   (other than the maximum length of entries.) The value passed in will
    --   be clamped to the range 0-65536.
    -> m ()
textSetMaxLength :: a -> Int32 -> m ()
textSetMaxLength self :: a
self length_ :: Int32
length_ = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Text -> Int32 -> IO ()
gtk_text_set_max_length Ptr Text
self' Int32
length_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetMaxLengthMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsText a) => O.MethodInfo TextSetMaxLengthMethodInfo a signature where
    overloadedMethod = textSetMaxLength

#endif

-- method Text::set_overwrite_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "overwrite"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_set_overwrite_mode" gtk_text_set_overwrite_mode :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    CInt ->                                 -- overwrite : TBasicType TBoolean
    IO ()

-- | Sets whether the text is overwritten when typing in the t'GI.Gtk.Objects.Text.Text'.
textSetOverwriteMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> Bool
    -- ^ /@overwrite@/: new value
    -> m ()
textSetOverwriteMode :: a -> Bool -> m ()
textSetOverwriteMode self :: a
self overwrite :: Bool
overwrite = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let overwrite' :: CInt
overwrite' = (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
overwrite
    Ptr Text -> CInt -> IO ()
gtk_text_set_overwrite_mode Ptr Text
self' CInt
overwrite'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetOverwriteModeMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsText a) => O.MethodInfo TextSetOverwriteModeMethodInfo a signature where
    overloadedMethod = textSetOverwriteMode

#endif

-- method Text::set_placeholder_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a string to be displayed when @self is empty and unfocused, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_set_placeholder_text" gtk_text_set_placeholder_text :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    CString ->                              -- text : TBasicType TUTF8
    IO ()

-- | Sets text to be displayed in /@self@/ when it is empty.
-- 
-- This can be used to give a visual hint of the expected
-- contents of the self.
textSetPlaceholderText ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> Maybe (T.Text)
    -- ^ /@text@/: a string to be displayed when /@self@/ is empty and unfocused, or 'P.Nothing'
    -> m ()
textSetPlaceholderText :: a -> Maybe Text -> m ()
textSetPlaceholderText self :: a
self text :: Maybe 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeText <- case Maybe Text
text of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jText :: Text
jText -> do
            CString
jText' <- Text -> IO CString
textToCString Text
jText
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jText'
    Ptr Text -> CString -> IO ()
gtk_text_set_placeholder_text Ptr Text
self' CString
maybeText
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeText
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetPlaceholderTextMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsText a) => O.MethodInfo TextSetPlaceholderTextMethodInfo a signature where
    overloadedMethod = textSetPlaceholderText

#endif

-- method Text::set_tabs
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tabs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "TabArray" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoTabArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_set_tabs" gtk_text_set_tabs :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    Ptr Pango.TabArray.TabArray ->          -- tabs : TInterface (Name {namespace = "Pango", name = "TabArray"})
    IO ()

-- | Sets a t'GI.Pango.Structs.TabArray.TabArray'; the tabstops in the array are applied to the self
-- text.
textSetTabs ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> Maybe (Pango.TabArray.TabArray)
    -- ^ /@tabs@/: a t'GI.Pango.Structs.TabArray.TabArray'
    -> m ()
textSetTabs :: a -> Maybe TabArray -> m ()
textSetTabs self :: a
self tabs :: Maybe TabArray
tabs = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TabArray
maybeTabs <- case Maybe TabArray
tabs of
        Nothing -> Ptr TabArray -> IO (Ptr TabArray)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TabArray
forall a. Ptr a
nullPtr
        Just jTabs :: TabArray
jTabs -> do
            Ptr TabArray
jTabs' <- TabArray -> IO (Ptr TabArray)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TabArray
jTabs
            Ptr TabArray -> IO (Ptr TabArray)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TabArray
jTabs'
    Ptr Text -> Ptr TabArray -> IO ()
gtk_text_set_tabs Ptr Text
self' Ptr TabArray
maybeTabs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe TabArray -> (TabArray -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TabArray
tabs TabArray -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetTabsMethodInfo
instance (signature ~ (Maybe (Pango.TabArray.TabArray) -> m ()), MonadIO m, IsText a) => O.MethodInfo TextSetTabsMethodInfo a signature where
    overloadedMethod = textSetTabs

#endif

-- method Text::set_visibility
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "visible"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%TRUE if the contents of the self are displayed\n          as plaintext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_set_visibility" gtk_text_set_visibility :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    CInt ->                                 -- visible : TBasicType TBoolean
    IO ()

-- | Sets whether the contents of the self are visible or not.
-- When visibility is set to 'P.False', characters are displayed
-- as the invisible char, and will also appear that way when
-- the text in the self widget is copied to the clipboard.
-- 
-- By default, GTK picks the best invisible character available
-- in the current font, but it can be changed with
-- 'GI.Gtk.Objects.Text.textSetInvisibleChar'.
-- 
-- Note that you probably want to set t'GI.Gtk.Objects.Text.Text':@/input-purpose/@
-- to 'GI.Gtk.Enums.InputPurposePassword' or 'GI.Gtk.Enums.InputPurposePin' to
-- inform input methods about the purpose of this self,
-- in addition to setting visibility to 'P.False'.
textSetVisibility ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> Bool
    -- ^ /@visible@/: 'P.True' if the contents of the self are displayed
    --           as plaintext
    -> m ()
textSetVisibility :: a -> Bool -> m ()
textSetVisibility self :: a
self visible :: Bool
visible = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let visible' :: CInt
visible' = (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
visible
    Ptr Text -> CInt -> IO ()
gtk_text_set_visibility Ptr Text
self' CInt
visible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetVisibilityMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsText a) => O.MethodInfo TextSetVisibilityMethodInfo a signature where
    overloadedMethod = textSetVisibility

#endif

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

foreign import ccall "gtk_text_unset_invisible_char" gtk_text_unset_invisible_char :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    IO ()

-- | Unsets the invisible char previously set with
-- 'GI.Gtk.Objects.Text.textSetInvisibleChar'. So that the
-- default invisible char is used again.
textUnsetInvisibleChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Text.Text'
    -> m ()
textUnsetInvisibleChar :: a -> m ()
textUnsetInvisibleChar self :: a
self = 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 Text
self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Text -> IO ()
gtk_text_unset_invisible_char Ptr Text
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextUnsetInvisibleCharMethodInfo
instance (signature ~ (m ()), MonadIO m, IsText a) => O.MethodInfo TextUnsetInvisibleCharMethodInfo a signature where
    overloadedMethod = textUnsetInvisibleChar

#endif