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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A single-line text entry.
-- 
-- @GtkText@ is the common implementation of single-line text editing
-- that is shared between t'GI.Gtk.Objects.Entry.Entry', t'GI.Gtk.Objects.PasswordEntry.PasswordEntry',
-- t'GI.Gtk.Objects.SpinButton.SpinButton', and other widgets. In all of these, a @GtkText@
-- instance is used as the delegate for the t'GI.Gtk.Interfaces.Editable.Editable' implementation.
-- 
-- A large number of key bindings s 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 an “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 want to add icons or progress display in an entry, look at
-- t'GI.Gtk.Objects.Entry.Entry'. There are other alternatives for more specialized
-- use cases, such as t'GI.Gtk.Objects.SearchEntry.SearchEntry'.
-- 
-- If you need multi-line editable text, use t'GI.Gtk.Objects.TextView.TextView'.
-- 
-- = Shortcuts and Gestures
-- 
-- @GtkText@ supports the following keyboard shortcuts:
-- 
-- * \<kbd>Shift\<\/kbd>+\<kbd>F10\<\/kbd> or \<kbd>Menu\<\/kbd> opens the context menu.
-- * \<kbd>Ctrl\<\/kbd>+\<kbd>A\<\/kbd> or \<kbd>Ctrl\<\/kbd>+\<kbd>&sol;\<\/kbd>
--   selects all the text.
-- * \<kbd>Ctrl\<\/kbd>+\<kbd>Shift\<\/kbd>+\<kbd>A\<\/kbd> or
--   \<kbd>Ctrl\<\/kbd>+\<kbd>&bsol;\<\/kbd> unselects all.
-- * \<kbd>Ctrl\<\/kbd>+\<kbd>Z\<\/kbd> undoes the last modification.
-- * \<kbd>Ctrl\<\/kbd>+\<kbd>Y\<\/kbd> or \<kbd>Ctrl\<\/kbd>+\<kbd>Shift\<\/kbd>+\<kbd>Z\<\/kbd>
--   redoes the last undone modification.
-- * \<kbd>Ctrl\<\/kbd>+\<kbd>Shift\<\/kbd>+\<kbd>T\<\/kbd> toggles the text direction.
-- 
-- 
-- Additionally, the following signals have default keybindings:
-- 
-- * [Text::activate]("GI.Gtk.Objects.Text#g:signal:activate")
-- * [Text::backspace]("GI.Gtk.Objects.Text#g:signal:backspace")
-- * [Text::copyClipboard]("GI.Gtk.Objects.Text#g:signal:copyClipboard")
-- * [Text::cutClipboard]("GI.Gtk.Objects.Text#g:signal:cutClipboard")
-- * [Text::deleteFromCursor]("GI.Gtk.Objects.Text#g:signal:deleteFromCursor")
-- * [Text::insertEmoji]("GI.Gtk.Objects.Text#g:signal:insertEmoji")
-- * [Text::moveCursor]("GI.Gtk.Objects.Text#g:signal:moveCursor")
-- * [Text::pasteClipboard]("GI.Gtk.Objects.Text#g:signal:pasteClipboard")
-- * [Text::toggleOverwrite]("GI.Gtk.Objects.Text#g:signal:toggleOverwrite")
-- 
-- 
-- = Actions
-- 
-- @GtkText@ defines a set of built-in actions:
-- 
-- * @clipboard.copy@ copies the contents to the clipboard.
-- * @clipboard.cut@ copies the contents to the clipboard and deletes it from
--   the widget.
-- * @clipboard.paste@ inserts the contents of the clipboard into the widget.
-- * @menu.popup@ opens the context menu.
-- * @misc.insert-emoji@ opens the Emoji chooser.
-- * @misc.toggle-visibility@ toggles the @GtkText@:visibility property.
-- * @misc.toggle-direction@ toggles the text direction.
-- * @selection.delete@ deletes the current selection.
-- * @selection.select-all@ selects all of the widgets content.
-- * @text.redo@ redoes the last change to the contents.
-- * @text.undo@ undoes the last change to the contents.
-- 
-- 
-- = CSS nodes
-- 
-- 
-- 	
-- >text[.read-only]
-- >├── placeholder
-- >├── undershoot.left
-- >├── undershoot.right
-- >├── [selection]
-- >├── [cursor-handle[.top]
-- >├── [cursor-handle.bottom]
-- >├── [block-cursor]
-- >├── [cursor-handle[.top/.bottom][.insertion-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 with the name @popup@.
-- 
-- The @undershoot@ nodes are used to draw the underflow indication when content
-- is scrolled out of view. These nodes get the @.left@ or @.right@ style class
-- 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@.
-- 
-- = Accessibility
-- 
-- @GtkText@ uses the 'GI.Gtk.Enums.AccessibleRoleNone' role, which causes it to be
-- skipped for accessibility. This is because @GtkText@ is expected to be used
-- as a delegate for a @GtkEditable@ implementation that will be represented
-- to accessibility.

#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                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actionSetEnabled]("GI.Gtk.Objects.Widget#g:method:actionSetEnabled"), [activate]("GI.Gtk.Objects.Widget#g:method:activate"), [activateAction]("GI.Gtk.Objects.Widget#g:method:activateAction"), [activateDefault]("GI.Gtk.Objects.Widget#g:method:activateDefault"), [addController]("GI.Gtk.Objects.Widget#g:method:addController"), [addCssClass]("GI.Gtk.Objects.Widget#g:method:addCssClass"), [addMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:addMnemonicLabel"), [addTickCallback]("GI.Gtk.Objects.Widget#g:method:addTickCallback"), [allocate]("GI.Gtk.Objects.Widget#g:method:allocate"), [announce]("GI.Gtk.Interfaces.Accessible#g:method:announce"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [childFocus]("GI.Gtk.Objects.Widget#g:method:childFocus"), [computeBounds]("GI.Gtk.Objects.Widget#g:method:computeBounds"), [computeCursorExtents]("GI.Gtk.Objects.Text#g:method:computeCursorExtents"), [computeExpand]("GI.Gtk.Objects.Widget#g:method:computeExpand"), [computePoint]("GI.Gtk.Objects.Widget#g:method:computePoint"), [computeTransform]("GI.Gtk.Objects.Widget#g:method:computeTransform"), [contains]("GI.Gtk.Objects.Widget#g:method:contains"), [createPangoContext]("GI.Gtk.Objects.Widget#g:method:createPangoContext"), [createPangoLayout]("GI.Gtk.Objects.Widget#g:method:createPangoLayout"), [delegateGetAccessiblePlatformState]("GI.Gtk.Interfaces.Editable#g:method:delegateGetAccessiblePlatformState"), [deleteSelection]("GI.Gtk.Interfaces.Editable#g:method:deleteSelection"), [deleteText]("GI.Gtk.Interfaces.Editable#g:method:deleteText"), [disposeTemplate]("GI.Gtk.Objects.Widget#g:method:disposeTemplate"), [dragCheckThreshold]("GI.Gtk.Objects.Widget#g:method:dragCheckThreshold"), [errorBell]("GI.Gtk.Objects.Widget#g:method:errorBell"), [finishDelegate]("GI.Gtk.Interfaces.Editable#g:method:finishDelegate"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [grabFocus]("GI.Gtk.Objects.Widget#g:method:grabFocus"), [grabFocusWithoutSelecting]("GI.Gtk.Objects.Text#g:method:grabFocusWithoutSelecting"), [hasCssClass]("GI.Gtk.Objects.Widget#g:method:hasCssClass"), [hasDefault]("GI.Gtk.Objects.Widget#g:method:hasDefault"), [hasFocus]("GI.Gtk.Objects.Widget#g:method:hasFocus"), [hasVisibleFocus]("GI.Gtk.Objects.Widget#g:method:hasVisibleFocus"), [hide]("GI.Gtk.Objects.Widget#g:method:hide"), [inDestruction]("GI.Gtk.Objects.Widget#g:method:inDestruction"), [initDelegate]("GI.Gtk.Interfaces.Editable#g:method:initDelegate"), [initTemplate]("GI.Gtk.Objects.Widget#g:method:initTemplate"), [insertActionGroup]("GI.Gtk.Objects.Widget#g:method:insertActionGroup"), [insertAfter]("GI.Gtk.Objects.Widget#g:method:insertAfter"), [insertBefore]("GI.Gtk.Objects.Widget#g:method:insertBefore"), [insertText]("GI.Gtk.Interfaces.Editable#g:method:insertText"), [isAncestor]("GI.Gtk.Objects.Widget#g:method:isAncestor"), [isDrawable]("GI.Gtk.Objects.Widget#g:method:isDrawable"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isFocus]("GI.Gtk.Objects.Widget#g:method:isFocus"), [isSensitive]("GI.Gtk.Objects.Widget#g:method:isSensitive"), [isVisible]("GI.Gtk.Objects.Widget#g:method:isVisible"), [keynavFailed]("GI.Gtk.Objects.Widget#g:method:keynavFailed"), [listMnemonicLabels]("GI.Gtk.Objects.Widget#g:method:listMnemonicLabels"), [map]("GI.Gtk.Objects.Widget#g:method:map"), [measure]("GI.Gtk.Objects.Widget#g:method:measure"), [mnemonicActivate]("GI.Gtk.Objects.Widget#g:method:mnemonicActivate"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [observeChildren]("GI.Gtk.Objects.Widget#g:method:observeChildren"), [observeControllers]("GI.Gtk.Objects.Widget#g:method:observeControllers"), [pick]("GI.Gtk.Objects.Widget#g:method:pick"), [queueAllocate]("GI.Gtk.Objects.Widget#g:method:queueAllocate"), [queueDraw]("GI.Gtk.Objects.Widget#g:method:queueDraw"), [queueResize]("GI.Gtk.Objects.Widget#g:method:queueResize"), [realize]("GI.Gtk.Objects.Widget#g:method:realize"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeController]("GI.Gtk.Objects.Widget#g:method:removeController"), [removeCssClass]("GI.Gtk.Objects.Widget#g:method:removeCssClass"), [removeMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:removeMnemonicLabel"), [removeTickCallback]("GI.Gtk.Objects.Widget#g:method:removeTickCallback"), [resetProperty]("GI.Gtk.Interfaces.Accessible#g:method:resetProperty"), [resetRelation]("GI.Gtk.Interfaces.Accessible#g:method:resetRelation"), [resetState]("GI.Gtk.Interfaces.Accessible#g:method:resetState"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [selectRegion]("GI.Gtk.Interfaces.Editable#g:method:selectRegion"), [shouldLayout]("GI.Gtk.Objects.Widget#g:method:shouldLayout"), [show]("GI.Gtk.Objects.Widget#g:method:show"), [sizeAllocate]("GI.Gtk.Objects.Widget#g:method:sizeAllocate"), [snapshotChild]("GI.Gtk.Objects.Widget#g:method:snapshotChild"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [translateCoordinates]("GI.Gtk.Objects.Widget#g:method:translateCoordinates"), [triggerTooltipQuery]("GI.Gtk.Objects.Widget#g:method:triggerTooltipQuery"), [unmap]("GI.Gtk.Objects.Widget#g:method:unmap"), [unparent]("GI.Gtk.Objects.Widget#g:method:unparent"), [unrealize]("GI.Gtk.Objects.Widget#g:method:unrealize"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unsetInvisibleChar]("GI.Gtk.Objects.Text#g:method:unsetInvisibleChar"), [unsetStateFlags]("GI.Gtk.Objects.Widget#g:method:unsetStateFlags"), [updateCaretPosition]("GI.Gtk.Interfaces.AccessibleText#g:method:updateCaretPosition"), [updateContents]("GI.Gtk.Interfaces.AccessibleText#g:method:updateContents"), [updateNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:updateNextAccessibleSibling"), [updatePlatformState]("GI.Gtk.Interfaces.Accessible#g:method:updatePlatformState"), [updateProperty]("GI.Gtk.Interfaces.Accessible#g:method:updateProperty"), [updateRelation]("GI.Gtk.Interfaces.Accessible#g:method:updateRelation"), [updateSelectionBound]("GI.Gtk.Interfaces.AccessibleText#g:method:updateSelectionBound"), [updateState]("GI.Gtk.Interfaces.Accessible#g:method:updateState"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleParent"), [getAccessibleRole]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleRole"), [getActivatesDefault]("GI.Gtk.Objects.Text#g:method:getActivatesDefault"), [getAlignment]("GI.Gtk.Interfaces.Editable#g:method:getAlignment"), [getAllocatedBaseline]("GI.Gtk.Objects.Widget#g:method:getAllocatedBaseline"), [getAllocatedHeight]("GI.Gtk.Objects.Widget#g:method:getAllocatedHeight"), [getAllocatedWidth]("GI.Gtk.Objects.Widget#g:method:getAllocatedWidth"), [getAllocation]("GI.Gtk.Objects.Widget#g:method:getAllocation"), [getAncestor]("GI.Gtk.Objects.Widget#g:method:getAncestor"), [getAtContext]("GI.Gtk.Interfaces.Accessible#g:method:getAtContext"), [getAttributes]("GI.Gtk.Objects.Text#g:method:getAttributes"), [getBaseline]("GI.Gtk.Objects.Widget#g:method:getBaseline"), [getBounds]("GI.Gtk.Interfaces.Accessible#g:method:getBounds"), [getBuffer]("GI.Gtk.Objects.Text#g:method:getBuffer"), [getBuildableId]("GI.Gtk.Interfaces.Buildable#g:method:getBuildableId"), [getCanFocus]("GI.Gtk.Objects.Widget#g:method:getCanFocus"), [getCanTarget]("GI.Gtk.Objects.Widget#g:method:getCanTarget"), [getChars]("GI.Gtk.Interfaces.Editable#g:method:getChars"), [getChildVisible]("GI.Gtk.Objects.Widget#g:method:getChildVisible"), [getClipboard]("GI.Gtk.Objects.Widget#g:method:getClipboard"), [getColor]("GI.Gtk.Objects.Widget#g:method:getColor"), [getCssClasses]("GI.Gtk.Objects.Widget#g:method:getCssClasses"), [getCssName]("GI.Gtk.Objects.Widget#g:method:getCssName"), [getCursor]("GI.Gtk.Objects.Widget#g:method:getCursor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDelegate]("GI.Gtk.Interfaces.Editable#g:method:getDelegate"), [getDirection]("GI.Gtk.Objects.Widget#g:method:getDirection"), [getDisplay]("GI.Gtk.Objects.Widget#g:method:getDisplay"), [getEditable]("GI.Gtk.Interfaces.Editable#g:method:getEditable"), [getEnableEmojiCompletion]("GI.Gtk.Objects.Text#g:method:getEnableEmojiCompletion"), [getEnableUndo]("GI.Gtk.Interfaces.Editable#g:method:getEnableUndo"), [getExtraMenu]("GI.Gtk.Objects.Text#g:method:getExtraMenu"), [getFirstAccessibleChild]("GI.Gtk.Interfaces.Accessible#g:method:getFirstAccessibleChild"), [getFirstChild]("GI.Gtk.Objects.Widget#g:method:getFirstChild"), [getFocusChild]("GI.Gtk.Objects.Widget#g:method:getFocusChild"), [getFocusOnClick]("GI.Gtk.Objects.Widget#g:method:getFocusOnClick"), [getFocusable]("GI.Gtk.Objects.Widget#g:method:getFocusable"), [getFontMap]("GI.Gtk.Objects.Widget#g:method:getFontMap"), [getFontOptions]("GI.Gtk.Objects.Widget#g:method:getFontOptions"), [getFrameClock]("GI.Gtk.Objects.Widget#g:method:getFrameClock"), [getHalign]("GI.Gtk.Objects.Widget#g:method:getHalign"), [getHasTooltip]("GI.Gtk.Objects.Widget#g:method:getHasTooltip"), [getHeight]("GI.Gtk.Objects.Widget#g:method:getHeight"), [getHexpand]("GI.Gtk.Objects.Widget#g:method:getHexpand"), [getHexpandSet]("GI.Gtk.Objects.Widget#g:method:getHexpandSet"), [getInputHints]("GI.Gtk.Objects.Text#g:method:getInputHints"), [getInputPurpose]("GI.Gtk.Objects.Text#g:method:getInputPurpose"), [getInvisibleChar]("GI.Gtk.Objects.Text#g:method:getInvisibleChar"), [getLastChild]("GI.Gtk.Objects.Widget#g:method:getLastChild"), [getLayoutManager]("GI.Gtk.Objects.Widget#g:method:getLayoutManager"), [getLimitEvents]("GI.Gtk.Objects.Widget#g:method:getLimitEvents"), [getMapped]("GI.Gtk.Objects.Widget#g:method:getMapped"), [getMarginBottom]("GI.Gtk.Objects.Widget#g:method:getMarginBottom"), [getMarginEnd]("GI.Gtk.Objects.Widget#g:method:getMarginEnd"), [getMarginStart]("GI.Gtk.Objects.Widget#g:method:getMarginStart"), [getMarginTop]("GI.Gtk.Objects.Widget#g:method:getMarginTop"), [getMaxLength]("GI.Gtk.Objects.Text#g:method:getMaxLength"), [getMaxWidthChars]("GI.Gtk.Interfaces.Editable#g:method:getMaxWidthChars"), [getName]("GI.Gtk.Objects.Widget#g:method:getName"), [getNative]("GI.Gtk.Objects.Widget#g:method:getNative"), [getNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:getNextAccessibleSibling"), [getNextSibling]("GI.Gtk.Objects.Widget#g:method:getNextSibling"), [getOpacity]("GI.Gtk.Objects.Widget#g:method:getOpacity"), [getOverflow]("GI.Gtk.Objects.Widget#g:method:getOverflow"), [getOverwriteMode]("GI.Gtk.Objects.Text#g:method:getOverwriteMode"), [getPangoContext]("GI.Gtk.Objects.Widget#g:method:getPangoContext"), [getParent]("GI.Gtk.Objects.Widget#g:method:getParent"), [getPlaceholderText]("GI.Gtk.Objects.Text#g:method:getPlaceholderText"), [getPlatformState]("GI.Gtk.Interfaces.Accessible#g:method:getPlatformState"), [getPosition]("GI.Gtk.Interfaces.Editable#g:method:getPosition"), [getPreferredSize]("GI.Gtk.Objects.Widget#g:method:getPreferredSize"), [getPrevSibling]("GI.Gtk.Objects.Widget#g:method:getPrevSibling"), [getPrimaryClipboard]("GI.Gtk.Objects.Widget#g:method:getPrimaryClipboard"), [getPropagateTextWidth]("GI.Gtk.Objects.Text#g:method:getPropagateTextWidth"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRealized]("GI.Gtk.Objects.Widget#g:method:getRealized"), [getReceivesDefault]("GI.Gtk.Objects.Widget#g:method:getReceivesDefault"), [getRequestMode]("GI.Gtk.Objects.Widget#g:method:getRequestMode"), [getRoot]("GI.Gtk.Objects.Widget#g:method:getRoot"), [getScaleFactor]("GI.Gtk.Objects.Widget#g:method:getScaleFactor"), [getSelectionBounds]("GI.Gtk.Interfaces.Editable#g:method:getSelectionBounds"), [getSensitive]("GI.Gtk.Objects.Widget#g:method:getSensitive"), [getSettings]("GI.Gtk.Objects.Widget#g:method:getSettings"), [getSize]("GI.Gtk.Objects.Widget#g:method:getSize"), [getSizeRequest]("GI.Gtk.Objects.Widget#g:method:getSizeRequest"), [getStateFlags]("GI.Gtk.Objects.Widget#g:method:getStateFlags"), [getStyleContext]("GI.Gtk.Objects.Widget#g:method:getStyleContext"), [getTabs]("GI.Gtk.Objects.Text#g:method:getTabs"), [getTemplateChild]("GI.Gtk.Objects.Widget#g:method:getTemplateChild"), [getText]("GI.Gtk.Interfaces.Editable#g:method:getText"), [getTextLength]("GI.Gtk.Objects.Text#g:method:getTextLength"), [getTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:getTooltipMarkup"), [getTooltipText]("GI.Gtk.Objects.Widget#g:method:getTooltipText"), [getTruncateMultiline]("GI.Gtk.Objects.Text#g:method:getTruncateMultiline"), [getValign]("GI.Gtk.Objects.Widget#g:method:getValign"), [getVexpand]("GI.Gtk.Objects.Widget#g:method:getVexpand"), [getVexpandSet]("GI.Gtk.Objects.Widget#g:method:getVexpandSet"), [getVisibility]("GI.Gtk.Objects.Text#g:method:getVisibility"), [getVisible]("GI.Gtk.Objects.Widget#g:method:getVisible"), [getWidth]("GI.Gtk.Objects.Widget#g:method:getWidth"), [getWidthChars]("GI.Gtk.Interfaces.Editable#g:method:getWidthChars").
-- 
-- ==== Setters
-- [setAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:setAccessibleParent"), [setActivatesDefault]("GI.Gtk.Objects.Text#g:method:setActivatesDefault"), [setAlignment]("GI.Gtk.Interfaces.Editable#g:method:setAlignment"), [setAttributes]("GI.Gtk.Objects.Text#g:method:setAttributes"), [setBuffer]("GI.Gtk.Objects.Text#g:method:setBuffer"), [setCanFocus]("GI.Gtk.Objects.Widget#g:method:setCanFocus"), [setCanTarget]("GI.Gtk.Objects.Widget#g:method:setCanTarget"), [setChildVisible]("GI.Gtk.Objects.Widget#g:method:setChildVisible"), [setCssClasses]("GI.Gtk.Objects.Widget#g:method:setCssClasses"), [setCursor]("GI.Gtk.Objects.Widget#g:method:setCursor"), [setCursorFromName]("GI.Gtk.Objects.Widget#g:method:setCursorFromName"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDirection]("GI.Gtk.Objects.Widget#g:method:setDirection"), [setEditable]("GI.Gtk.Interfaces.Editable#g:method:setEditable"), [setEnableEmojiCompletion]("GI.Gtk.Objects.Text#g:method:setEnableEmojiCompletion"), [setEnableUndo]("GI.Gtk.Interfaces.Editable#g:method:setEnableUndo"), [setExtraMenu]("GI.Gtk.Objects.Text#g:method:setExtraMenu"), [setFocusChild]("GI.Gtk.Objects.Widget#g:method:setFocusChild"), [setFocusOnClick]("GI.Gtk.Objects.Widget#g:method:setFocusOnClick"), [setFocusable]("GI.Gtk.Objects.Widget#g:method:setFocusable"), [setFontMap]("GI.Gtk.Objects.Widget#g:method:setFontMap"), [setFontOptions]("GI.Gtk.Objects.Widget#g:method:setFontOptions"), [setHalign]("GI.Gtk.Objects.Widget#g:method:setHalign"), [setHasTooltip]("GI.Gtk.Objects.Widget#g:method:setHasTooltip"), [setHexpand]("GI.Gtk.Objects.Widget#g:method:setHexpand"), [setHexpandSet]("GI.Gtk.Objects.Widget#g:method:setHexpandSet"), [setInputHints]("GI.Gtk.Objects.Text#g:method:setInputHints"), [setInputPurpose]("GI.Gtk.Objects.Text#g:method:setInputPurpose"), [setInvisibleChar]("GI.Gtk.Objects.Text#g:method:setInvisibleChar"), [setLayoutManager]("GI.Gtk.Objects.Widget#g:method:setLayoutManager"), [setLimitEvents]("GI.Gtk.Objects.Widget#g:method:setLimitEvents"), [setMarginBottom]("GI.Gtk.Objects.Widget#g:method:setMarginBottom"), [setMarginEnd]("GI.Gtk.Objects.Widget#g:method:setMarginEnd"), [setMarginStart]("GI.Gtk.Objects.Widget#g:method:setMarginStart"), [setMarginTop]("GI.Gtk.Objects.Widget#g:method:setMarginTop"), [setMaxLength]("GI.Gtk.Objects.Text#g:method:setMaxLength"), [setMaxWidthChars]("GI.Gtk.Interfaces.Editable#g:method:setMaxWidthChars"), [setName]("GI.Gtk.Objects.Widget#g:method:setName"), [setOpacity]("GI.Gtk.Objects.Widget#g:method:setOpacity"), [setOverflow]("GI.Gtk.Objects.Widget#g:method:setOverflow"), [setOverwriteMode]("GI.Gtk.Objects.Text#g:method:setOverwriteMode"), [setParent]("GI.Gtk.Objects.Widget#g:method:setParent"), [setPlaceholderText]("GI.Gtk.Objects.Text#g:method:setPlaceholderText"), [setPosition]("GI.Gtk.Interfaces.Editable#g:method:setPosition"), [setPropagateTextWidth]("GI.Gtk.Objects.Text#g:method:setPropagateTextWidth"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setReceivesDefault]("GI.Gtk.Objects.Widget#g:method:setReceivesDefault"), [setSensitive]("GI.Gtk.Objects.Widget#g:method:setSensitive"), [setSizeRequest]("GI.Gtk.Objects.Widget#g:method:setSizeRequest"), [setStateFlags]("GI.Gtk.Objects.Widget#g:method:setStateFlags"), [setTabs]("GI.Gtk.Objects.Text#g:method:setTabs"), [setText]("GI.Gtk.Interfaces.Editable#g:method:setText"), [setTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:setTooltipMarkup"), [setTooltipText]("GI.Gtk.Objects.Widget#g:method:setTooltipText"), [setTruncateMultiline]("GI.Gtk.Objects.Text#g:method:setTruncateMultiline"), [setValign]("GI.Gtk.Objects.Widget#g:method:setValign"), [setVexpand]("GI.Gtk.Objects.Widget#g:method:setVexpand"), [setVexpandSet]("GI.Gtk.Objects.Widget#g:method:setVexpandSet"), [setVisibility]("GI.Gtk.Objects.Text#g:method:setVisibility"), [setVisible]("GI.Gtk.Objects.Widget#g:method:setVisible"), [setWidthChars]("GI.Gtk.Interfaces.Editable#g:method:setWidthChars").

#if defined(ENABLE_OVERLOADING)
    ResolveTextMethod                       ,
#endif

-- ** computeCursorExtents #method:computeCursorExtents#

#if defined(ENABLE_OVERLOADING)
    TextComputeCursorExtentsMethodInfo      ,
#endif
    textComputeCursorExtents                ,


-- ** 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                           ,


-- ** getEnableEmojiCompletion #method:getEnableEmojiCompletion#

#if defined(ENABLE_OVERLOADING)
    TextGetEnableEmojiCompletionMethodInfo  ,
#endif
    textGetEnableEmojiCompletion            ,


-- ** getExtraMenu #method:getExtraMenu#

#if defined(ENABLE_OVERLOADING)
    TextGetExtraMenuMethodInfo              ,
#endif
    textGetExtraMenu                        ,


-- ** 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                  ,


-- ** getPropagateTextWidth #method:getPropagateTextWidth#

#if defined(ENABLE_OVERLOADING)
    TextGetPropagateTextWidthMethodInfo     ,
#endif
    textGetPropagateTextWidth               ,


-- ** getTabs #method:getTabs#

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


-- ** getTextLength #method:getTextLength#

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


-- ** getTruncateMultiline #method:getTruncateMultiline#

#if defined(ENABLE_OVERLOADING)
    TextGetTruncateMultilineMethodInfo      ,
#endif
    textGetTruncateMultiline                ,


-- ** 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                           ,


-- ** setEnableEmojiCompletion #method:setEnableEmojiCompletion#

#if defined(ENABLE_OVERLOADING)
    TextSetEnableEmojiCompletionMethodInfo  ,
#endif
    textSetEnableEmojiCompletion            ,


-- ** setExtraMenu #method:setExtraMenu#

#if defined(ENABLE_OVERLOADING)
    TextSetExtraMenuMethodInfo              ,
#endif
    textSetExtraMenu                        ,


-- ** 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                  ,


-- ** setPropagateTextWidth #method:setPropagateTextWidth#

#if defined(ENABLE_OVERLOADING)
    TextSetPropagateTextWidthMethodInfo     ,
#endif
    textSetPropagateTextWidth               ,


-- ** setTabs #method:setTabs#

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


-- ** setTruncateMultiline #method:setTruncateMultiline#

#if defined(ENABLE_OVERLOADING)
    TextSetTruncateMultilineMethodInfo      ,
#endif
    textSetTruncateMultiline                ,


-- ** setVisibility #method:setVisibility#

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


-- ** unsetInvisibleChar #method:unsetInvisibleChar#

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




 -- * Properties


-- ** activatesDefault #attr:activatesDefault#
-- | Whether to activate the default widget when \<kbd>Enter\<\/kbd> is pressed.

#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.
-- 
-- This is mainly useful to change the size or weight of the text.
-- 
-- The @PangoAttribute@\'s /@startIndex@/ and /@endIndex@/ must refer to the
-- @GtkEntryBuffer@ text, i.e. without the preedit string.

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


-- ** buffer #attr:buffer#
-- | The @GtkEntryBuffer@ object which stores the text.

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


-- ** enableEmojiCompletion #attr:enableEmojiCompletion#
-- | Whether to suggest Emoji replacements.

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


-- ** extraMenu #attr:extraMenu#
-- | A menu model whose contents will be appended to the context menu.

#if defined(ENABLE_OVERLOADING)
    TextExtraMenuPropertyInfo               ,
#endif
    clearTextExtraMenu                      ,
    constructTextExtraMenu                  ,
    getTextExtraMenu                        ,
    setTextExtraMenu                        ,
#if defined(ENABLE_OVERLOADING)
    textExtraMenu                           ,
#endif


-- ** imModule #attr:imModule#
-- | Which input method module should be used.
-- 
-- See t'GI.Gtk.Objects.IMMulticontext.IMMulticontext'.
-- 
-- Setting this to a non-@NULL@ value overrides the system-wide
-- input method. See the [Settings:gtkImModule]("GI.Gtk.Objects.Settings#g:attr:gtkImModule")
-- setting.

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


-- ** inputHints #attr:inputHints#
-- | Additional hints 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 information 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
-- [Text:visibility]("GI.Gtk.Objects.Text#g:attr:visibility").

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


-- ** invisibleChar #attr:invisibleChar#
-- | The character to used when masking contents (in “password mode”).

#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.

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


-- ** maxLength #attr:maxLength#
-- | Maximum number of characters that are allowed.
-- 
-- Zero indicates no limit.

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


-- ** overwriteMode #attr:overwriteMode#
-- | If text is overwritten when typing.

#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 @GtkText@ when it is empty
-- and unfocused.

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


-- ** propagateTextWidth #attr:propagateTextWidth#
-- | Whether the widget should grow and shrink with the content.

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


-- ** scrollOffset #attr:scrollOffset#
-- | Number of pixels scrolled of the screen to the left.

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


-- ** tabs #attr:tabs#
-- | Custom tabs for this text widget.

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


-- ** truncateMultiline #attr:truncateMultiline#
-- | When 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#
-- | If false, the text is masked with the “invisible char”.

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




 -- * Signals


-- ** activate #signal:activate#

    TextActivateCallback                    ,
#if defined(ENABLE_OVERLOADING)
    TextActivateSignalInfo                  ,
#endif
    afterTextActivate                       ,
    onTextActivate                          ,


-- ** backspace #signal:backspace#

    TextBackspaceCallback                   ,
#if defined(ENABLE_OVERLOADING)
    TextBackspaceSignalInfo                 ,
#endif
    afterTextBackspace                      ,
    onTextBackspace                         ,


-- ** copyClipboard #signal:copyClipboard#

    TextCopyClipboardCallback               ,
#if defined(ENABLE_OVERLOADING)
    TextCopyClipboardSignalInfo             ,
#endif
    afterTextCopyClipboard                  ,
    onTextCopyClipboard                     ,


-- ** cutClipboard #signal:cutClipboard#

    TextCutClipboardCallback                ,
#if defined(ENABLE_OVERLOADING)
    TextCutClipboardSignalInfo              ,
#endif
    afterTextCutClipboard                   ,
    onTextCutClipboard                      ,


-- ** deleteFromCursor #signal:deleteFromCursor#

    TextDeleteFromCursorCallback            ,
#if defined(ENABLE_OVERLOADING)
    TextDeleteFromCursorSignalInfo          ,
#endif
    afterTextDeleteFromCursor               ,
    onTextDeleteFromCursor                  ,


-- ** insertAtCursor #signal:insertAtCursor#

    TextInsertAtCursorCallback              ,
#if defined(ENABLE_OVERLOADING)
    TextInsertAtCursorSignalInfo            ,
#endif
    afterTextInsertAtCursor                 ,
    onTextInsertAtCursor                    ,


-- ** insertEmoji #signal:insertEmoji#

    TextInsertEmojiCallback                 ,
#if defined(ENABLE_OVERLOADING)
    TextInsertEmojiSignalInfo               ,
#endif
    afterTextInsertEmoji                    ,
    onTextInsertEmoji                       ,


-- ** moveCursor #signal:moveCursor#

    TextMoveCursorCallback                  ,
#if defined(ENABLE_OVERLOADING)
    TextMoveCursorSignalInfo                ,
#endif
    afterTextMoveCursor                     ,
    onTextMoveCursor                        ,


-- ** pasteClipboard #signal:pasteClipboard#

    TextPasteClipboardCallback              ,
#if defined(ENABLE_OVERLOADING)
    TextPasteClipboardSignalInfo            ,
#endif
    afterTextPasteClipboard                 ,
    onTextPasteClipboard                    ,


-- ** preeditChanged #signal:preeditChanged#

    TextPreeditChangedCallback              ,
#if defined(ENABLE_OVERLOADING)
    TextPreeditChangedSignalInfo            ,
#endif
    afterTextPreeditChanged                 ,
    onTextPreeditChanged                    ,


-- ** toggleOverwrite #signal:toggleOverwrite#

    TextToggleOverwriteCallback             ,
#if defined(ENABLE_OVERLOADING)
    TextToggleOverwriteSignalInfo           ,
#endif
    afterTextToggleOverwrite                ,
    onTextToggleOverwrite                   ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GObject.Structs.ObjectClass as GObject.ObjectClass
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.Clipboard as Gdk.Clipboard
import qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
import qualified GI.Gdk.Objects.Device as Gdk.Device
import qualified GI.Gdk.Objects.Display as Gdk.Display
import qualified GI.Gdk.Objects.Event as Gdk.Event
import qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import qualified GI.Gdk.Objects.Surface as Gdk.Surface
import qualified GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import qualified GI.Graphene.Structs.Matrix as Graphene.Matrix
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Point3D as Graphene.Point3D
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Graphene.Structs.Size as Graphene.Size
import qualified GI.Graphene.Structs.Vec3 as Graphene.Vec3
import qualified GI.Graphene.Structs.Vec4 as Graphene.Vec4
import qualified GI.Gsk.Enums as Gsk.Enums
import qualified GI.Gsk.Objects.GLShader as Gsk.GLShader
import qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import qualified GI.Gsk.Objects.Renderer as Gsk.Renderer
import qualified GI.Gsk.Structs.ColorStop as Gsk.ColorStop
import qualified GI.Gsk.Structs.Path as Gsk.Path
import qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect
import qualified GI.Gsk.Structs.Shadow as Gsk.Shadow
import qualified GI.Gsk.Structs.Stroke as Gsk.Stroke
import qualified GI.Gsk.Structs.Transform as Gsk.Transform
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.AccessibleText as Gtk.AccessibleText
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Editable as Gtk.Editable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Native as Gtk.Native
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Root as Gtk.Root
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.StyleProvider as Gtk.StyleProvider
import {-# SOURCE #-} qualified GI.Gtk.Objects.ATContext as Gtk.ATContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.EntryBuffer as Gtk.EntryBuffer
import {-# SOURCE #-} qualified GI.Gtk.Objects.EventController as Gtk.EventController
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutChild as Gtk.LayoutChild
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutManager as Gtk.LayoutManager
import {-# SOURCE #-} qualified GI.Gtk.Objects.Settings as Gtk.Settings
import {-# SOURCE #-} qualified GI.Gtk.Objects.Snapshot as Gtk.Snapshot
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.Tooltip as Gtk.Tooltip
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.Gtk.Structs.Border as Gtk.Border
import {-# SOURCE #-} qualified GI.Gtk.Structs.Requisition as Gtk.Requisition
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Objects.Context as Pango.Context
import qualified GI.Pango.Objects.FontMap as Pango.FontMap
import qualified GI.Pango.Objects.Layout as Pango.Layout
import qualified GI.Pango.Structs.AttrList as Pango.AttrList
import qualified GI.Pango.Structs.TabArray as Pango.TabArray

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.AccessibleText as Gtk.AccessibleText
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
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

#endif

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

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

foreign import ccall "gtk_text_get_type"
    c_gtk_text_get_type :: IO B.Types.GType

instance B.Types.TypedObject Text where
    glibType :: IO GType
glibType = IO GType
c_gtk_text_get_type

instance B.Types.GObject Text

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

instance O.HasParentTypes Text
type instance O.ParentTypes Text = '[Gtk.Widget.Widget, GObject.Object.Object, Gtk.Accessible.Accessible, Gtk.AccessibleText.AccessibleText, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget, Gtk.Editable.Editable]

-- | Cast to t'Text', for types for which this is known to be safe. For general casts, use 'Data.GI.Base.ManagedPtr.castTo'.
toText :: (MIO.MonadIO m, IsText o) => o -> m Text
toText :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Text
toText = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> (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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Text -> Text
Text

-- | Convert t'Text' to and from t'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Text) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_text_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Text -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Text
P.Nothing = Ptr GValue -> Ptr Text -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Text
forall a. Ptr a
FP.nullPtr :: FP.Ptr Text)
    gvalueSet_ Ptr GValue
gv (P.Just Text
obj) = Text -> (Ptr Text -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Text
obj (Ptr GValue -> Ptr Text -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Text)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr Text)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Text)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newObject Text ptr
        else return P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveTextMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTextMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveTextMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveTextMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveTextMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveTextMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveTextMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveTextMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveTextMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveTextMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveTextMethod "announce" o = Gtk.Accessible.AccessibleAnnounceMethodInfo
    ResolveTextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTextMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveTextMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveTextMethod "computeCursorExtents" o = TextComputeCursorExtentsMethodInfo
    ResolveTextMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveTextMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveTextMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveTextMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveTextMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveTextMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveTextMethod "delegateGetAccessiblePlatformState" o = Gtk.Editable.EditableDelegateGetAccessiblePlatformStateMethodInfo
    ResolveTextMethod "deleteSelection" o = Gtk.Editable.EditableDeleteSelectionMethodInfo
    ResolveTextMethod "deleteText" o = Gtk.Editable.EditableDeleteTextMethodInfo
    ResolveTextMethod "disposeTemplate" o = Gtk.Widget.WidgetDisposeTemplateMethodInfo
    ResolveTextMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveTextMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    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 "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveTextMethod "grabFocusWithoutSelecting" o = TextGrabFocusWithoutSelectingMethodInfo
    ResolveTextMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveTextMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveTextMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    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 "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 "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveTextMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    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 "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveTextMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveTextMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveTextMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveTextMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveTextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTextMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveTextMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveTextMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveTextMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveTextMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
    ResolveTextMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
    ResolveTextMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
    ResolveTextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTextMethod "selectRegion" o = Gtk.Editable.EditableSelectRegionMethodInfo
    ResolveTextMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    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 "unsetInvisibleChar" o = TextUnsetInvisibleCharMethodInfo
    ResolveTextMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveTextMethod "updateCaretPosition" o = Gtk.AccessibleText.AccessibleTextUpdateCaretPositionMethodInfo
    ResolveTextMethod "updateContents" o = Gtk.AccessibleText.AccessibleTextUpdateContentsMethodInfo
    ResolveTextMethod "updateNextAccessibleSibling" o = Gtk.Accessible.AccessibleUpdateNextAccessibleSiblingMethodInfo
    ResolveTextMethod "updatePlatformState" o = Gtk.Accessible.AccessibleUpdatePlatformStateMethodInfo
    ResolveTextMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
    ResolveTextMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
    ResolveTextMethod "updateSelectionBound" o = Gtk.AccessibleText.AccessibleTextUpdateSelectionBoundMethodInfo
    ResolveTextMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
    ResolveTextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTextMethod "getAccessibleParent" o = Gtk.Accessible.AccessibleGetAccessibleParentMethodInfo
    ResolveTextMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
    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 "getAtContext" o = Gtk.Accessible.AccessibleGetAtContextMethodInfo
    ResolveTextMethod "getAttributes" o = TextGetAttributesMethodInfo
    ResolveTextMethod "getBaseline" o = Gtk.Widget.WidgetGetBaselineMethodInfo
    ResolveTextMethod "getBounds" o = Gtk.Accessible.AccessibleGetBoundsMethodInfo
    ResolveTextMethod "getBuffer" o = TextGetBufferMethodInfo
    ResolveTextMethod "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
    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 "getColor" o = Gtk.Widget.WidgetGetColorMethodInfo
    ResolveTextMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveTextMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveTextMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveTextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTextMethod "getDelegate" o = Gtk.Editable.EditableGetDelegateMethodInfo
    ResolveTextMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveTextMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveTextMethod "getEditable" o = Gtk.Editable.EditableGetEditableMethodInfo
    ResolveTextMethod "getEnableEmojiCompletion" o = TextGetEnableEmojiCompletionMethodInfo
    ResolveTextMethod "getEnableUndo" o = Gtk.Editable.EditableGetEnableUndoMethodInfo
    ResolveTextMethod "getExtraMenu" o = TextGetExtraMenuMethodInfo
    ResolveTextMethod "getFirstAccessibleChild" o = Gtk.Accessible.AccessibleGetFirstAccessibleChildMethodInfo
    ResolveTextMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveTextMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveTextMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveTextMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    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 "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 "getInvisibleChar" o = TextGetInvisibleCharMethodInfo
    ResolveTextMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveTextMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveTextMethod "getLimitEvents" o = Gtk.Widget.WidgetGetLimitEventsMethodInfo
    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 "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveTextMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveTextMethod "getNextAccessibleSibling" o = Gtk.Accessible.AccessibleGetNextAccessibleSiblingMethodInfo
    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 "getPlaceholderText" o = TextGetPlaceholderTextMethodInfo
    ResolveTextMethod "getPlatformState" o = Gtk.Accessible.AccessibleGetPlatformStateMethodInfo
    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 "getPropagateTextWidth" o = TextGetPropagateTextWidthMethodInfo
    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 "getSize" o = Gtk.Widget.WidgetGetSizeMethodInfo
    ResolveTextMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveTextMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveTextMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    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 "getTruncateMultiline" o = TextGetTruncateMultilineMethodInfo
    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 "setAccessibleParent" o = Gtk.Accessible.AccessibleSetAccessibleParentMethodInfo
    ResolveTextMethod "setActivatesDefault" o = TextSetActivatesDefaultMethodInfo
    ResolveTextMethod "setAlignment" o = Gtk.Editable.EditableSetAlignmentMethodInfo
    ResolveTextMethod "setAttributes" o = TextSetAttributesMethodInfo
    ResolveTextMethod "setBuffer" o = TextSetBufferMethodInfo
    ResolveTextMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveTextMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveTextMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveTextMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    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 "setEnableEmojiCompletion" o = TextSetEnableEmojiCompletionMethodInfo
    ResolveTextMethod "setEnableUndo" o = Gtk.Editable.EditableSetEnableUndoMethodInfo
    ResolveTextMethod "setExtraMenu" o = TextSetExtraMenuMethodInfo
    ResolveTextMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveTextMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveTextMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveTextMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveTextMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveTextMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    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 "setLimitEvents" o = Gtk.Widget.WidgetSetLimitEventsMethodInfo
    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 "setPropagateTextWidth" o = TextSetPropagateTextWidthMethodInfo
    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 "setTabs" o = TextSetTabsMethodInfo
    ResolveTextMethod "setText" o = Gtk.Editable.EditableSetTextMethodInfo
    ResolveTextMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveTextMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveTextMethod "setTruncateMultiline" o = TextSetTruncateMultilineMethodInfo
    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.OverloadedMethod 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

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

#endif

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

#endif

-- signal Text::activate
-- | Emitted when the user hits the \<kbd>Enter\<\/kbd> key.
-- 
-- The default bindings for this signal are all forms
-- of the \<kbd>Enter\<\/kbd> key.
type TextActivateCallback =
    IO ()

type C_TextActivateCallback =
    Ptr Text ->                             -- 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_TextActivateCallback :: 
    GObject a => (a -> TextActivateCallback) ->
    C_TextActivateCallback
wrap_TextActivateCallback :: forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextActivateCallback a -> IO ()
gi'cb Ptr Text
gi'selfPtr Ptr ()
_ = do
    Ptr Text -> (Text -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Text
gi'selfPtr ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
gi'self -> a -> IO ()
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self) 


-- | 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 -> ((?self :: a) => TextActivateCallback) -> m SignalHandlerId
onTextActivate :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTextActivate a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextActivateCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextActivateCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "activate" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextActivate :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextActivateCallback) -> m SignalHandlerId
afterTextActivate :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTextActivate a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextActivateCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextActivateCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "activate" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::activate"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:activate"})

#endif

-- signal Text::backspace
-- | Emitted when the user asks for it.
-- 
-- This is a <https://docs.gtk.org/gtk4/class.SignalAction.html keybinding signal>.
-- 
-- The default bindings for this signal are
-- \<kbd>Backspace\<\/kbd> and \<kbd>Shift\<\/kbd>+\<kbd>Backspace\<\/kbd>.
type TextBackspaceCallback =
    IO ()

type C_TextBackspaceCallback =
    Ptr Text ->                             -- 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_TextBackspaceCallback :: 
    GObject a => (a -> TextBackspaceCallback) ->
    C_TextBackspaceCallback
wrap_TextBackspaceCallback :: forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextBackspaceCallback a -> IO ()
gi'cb Ptr Text
gi'selfPtr Ptr ()
_ = do
    Ptr Text -> (Text -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Text
gi'selfPtr ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
gi'self -> a -> IO ()
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self) 


-- | 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 -> ((?self :: a) => TextBackspaceCallback) -> m SignalHandlerId
onTextBackspace :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTextBackspace a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextBackspaceCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextBackspaceCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "backspace" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextBackspace :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextBackspaceCallback) -> m SignalHandlerId
afterTextBackspace :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTextBackspace a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextBackspaceCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextBackspaceCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "backspace" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::backspace"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:backspace"})

#endif

-- signal Text::copy-clipboard
-- | Emitted to copy the selection to the clipboard.
-- 
-- This is a <https://docs.gtk.org/gtk4/class.SignalAction.html keybinding signal>.
-- 
-- The default bindings for this signal are
-- \<kbd>Ctrl\<\/kbd>+\<kbd>c\<\/kbd> and
-- \<kbd>Ctrl\<\/kbd>+\<kbd>Insert\<\/kbd>.
type TextCopyClipboardCallback =
    IO ()

type C_TextCopyClipboardCallback =
    Ptr Text ->                             -- 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_TextCopyClipboardCallback :: 
    GObject a => (a -> TextCopyClipboardCallback) ->
    C_TextCopyClipboardCallback
wrap_TextCopyClipboardCallback :: forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextCopyClipboardCallback a -> IO ()
gi'cb Ptr Text
gi'selfPtr Ptr ()
_ = do
    Ptr Text -> (Text -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Text
gi'selfPtr ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
gi'self -> a -> IO ()
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self) 


-- | 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 -> ((?self :: a) => TextCopyClipboardCallback) -> m SignalHandlerId
onTextCopyClipboard :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTextCopyClipboard a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextCopyClipboardCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextCopyClipboardCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "copy-clipboard" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextCopyClipboard :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextCopyClipboardCallback) -> m SignalHandlerId
afterTextCopyClipboard :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTextCopyClipboard a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextCopyClipboardCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextCopyClipboardCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "copy-clipboard" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::copy-clipboard"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:copyClipboard"})

#endif

-- signal Text::cut-clipboard
-- | Emitted to cut the selection to the clipboard.
-- 
-- This is a <https://docs.gtk.org/gtk4/class.SignalAction.html keybinding signal>.
-- 
-- The default bindings for this signal are
-- \<kbd>Ctrl\<\/kbd>+\<kbd>x\<\/kbd> and
-- \<kbd>Shift\<\/kbd>+\<kbd>Delete\<\/kbd>.
type TextCutClipboardCallback =
    IO ()

type C_TextCutClipboardCallback =
    Ptr Text ->                             -- 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_TextCutClipboardCallback :: 
    GObject a => (a -> TextCutClipboardCallback) ->
    C_TextCutClipboardCallback
wrap_TextCutClipboardCallback :: forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextCutClipboardCallback a -> IO ()
gi'cb Ptr Text
gi'selfPtr Ptr ()
_ = do
    Ptr Text -> (Text -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Text
gi'selfPtr ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
gi'self -> a -> IO ()
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self) 


-- | 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 -> ((?self :: a) => TextCutClipboardCallback) -> m SignalHandlerId
onTextCutClipboard :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTextCutClipboard a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextCutClipboardCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextCutClipboardCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "cut-clipboard" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextCutClipboard :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextCutClipboardCallback) -> m SignalHandlerId
afterTextCutClipboard :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTextCutClipboard a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextCutClipboardCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextCutClipboardCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "cut-clipboard" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::cut-clipboard"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:cutClipboard"})

#endif

-- signal Text::delete-from-cursor
-- | Emitted when the user initiates a text deletion.
-- 
-- This is a <https://docs.gtk.org/gtk4/class.SignalAction.html keybinding signal>.
-- 
-- 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 \<kbd>Delete\<\/kbd>
-- for deleting a character and \<kbd>Ctrl\<\/kbd>+\<kbd>Delete\<\/kbd>
-- for deleting a word.
type TextDeleteFromCursorCallback =
    Gtk.Enums.DeleteType
    -- ^ /@type@/: the granularity of the deletion
    -> Int32
    -- ^ /@count@/: the number of /@type@/ units to delete
    -> IO ()

type C_TextDeleteFromCursorCallback =
    Ptr Text ->                             -- 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_TextDeleteFromCursorCallback :: 
    GObject a => (a -> TextDeleteFromCursorCallback) ->
    C_TextDeleteFromCursorCallback
wrap_TextDeleteFromCursorCallback :: forall a.
GObject a =>
(a -> TextDeleteFromCursorCallback)
-> C_TextDeleteFromCursorCallback
wrap_TextDeleteFromCursorCallback a -> TextDeleteFromCursorCallback
gi'cb Ptr Text
gi'selfPtr CUInt
type_ Int32
count Ptr ()
_ = 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_
    Ptr Text -> (Text -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Text
gi'selfPtr ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
gi'self -> a -> TextDeleteFromCursorCallback
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self)  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 -> ((?self :: a) => TextDeleteFromCursorCallback) -> m SignalHandlerId
onTextDeleteFromCursor :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a
-> ((?self::a) => TextDeleteFromCursorCallback)
-> m SignalHandlerId
onTextDeleteFromCursor a
obj (?self::a) => TextDeleteFromCursorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TextDeleteFromCursorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextDeleteFromCursorCallback
TextDeleteFromCursorCallback
cb
    let wrapped' :: C_TextDeleteFromCursorCallback
wrapped' = (a -> TextDeleteFromCursorCallback)
-> C_TextDeleteFromCursorCallback
forall a.
GObject a =>
(a -> TextDeleteFromCursorCallback)
-> C_TextDeleteFromCursorCallback
wrap_TextDeleteFromCursorCallback a -> TextDeleteFromCursorCallback
wrapped
    wrapped'' <- C_TextDeleteFromCursorCallback
-> IO (FunPtr C_TextDeleteFromCursorCallback)
mk_TextDeleteFromCursorCallback C_TextDeleteFromCursorCallback
wrapped'
    connectSignalFunPtr obj "delete-from-cursor" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextDeleteFromCursor :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextDeleteFromCursorCallback) -> m SignalHandlerId
afterTextDeleteFromCursor :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a
-> ((?self::a) => TextDeleteFromCursorCallback)
-> m SignalHandlerId
afterTextDeleteFromCursor a
obj (?self::a) => TextDeleteFromCursorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TextDeleteFromCursorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextDeleteFromCursorCallback
TextDeleteFromCursorCallback
cb
    let wrapped' :: C_TextDeleteFromCursorCallback
wrapped' = (a -> TextDeleteFromCursorCallback)
-> C_TextDeleteFromCursorCallback
forall a.
GObject a =>
(a -> TextDeleteFromCursorCallback)
-> C_TextDeleteFromCursorCallback
wrap_TextDeleteFromCursorCallback a -> TextDeleteFromCursorCallback
wrapped
    wrapped'' <- C_TextDeleteFromCursorCallback
-> IO (FunPtr C_TextDeleteFromCursorCallback)
mk_TextDeleteFromCursorCallback C_TextDeleteFromCursorCallback
wrapped'
    connectSignalFunPtr obj "delete-from-cursor" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::delete-from-cursor"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:deleteFromCursor"})

#endif

-- signal Text::insert-at-cursor
-- | Emitted when the user initiates the insertion of a
-- fixed string at the cursor.
-- 
-- This is a <https://docs.gtk.org/gtk4/class.SignalAction.html keybinding signal>.
-- 
-- This signal has no default bindings.
type TextInsertAtCursorCallback =
    T.Text
    -- ^ /@string@/: the string to insert
    -> IO ()

type C_TextInsertAtCursorCallback =
    Ptr Text ->                             -- 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_TextInsertAtCursorCallback :: 
    GObject a => (a -> TextInsertAtCursorCallback) ->
    C_TextInsertAtCursorCallback
wrap_TextInsertAtCursorCallback :: forall a.
GObject a =>
(a -> TextInsertAtCursorCallback) -> C_TextInsertAtCursorCallback
wrap_TextInsertAtCursorCallback a -> TextInsertAtCursorCallback
gi'cb Ptr Text
gi'selfPtr CString
string Ptr ()
_ = do
    string' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
string
    B.ManagedPtr.withNewObject gi'selfPtr $ \Text
gi'self -> a -> TextInsertAtCursorCallback
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self)  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 -> ((?self :: a) => TextInsertAtCursorCallback) -> m SignalHandlerId
onTextInsertAtCursor :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a
-> ((?self::a) => TextInsertAtCursorCallback) -> m SignalHandlerId
onTextInsertAtCursor a
obj (?self::a) => TextInsertAtCursorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TextInsertAtCursorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextInsertAtCursorCallback
TextInsertAtCursorCallback
cb
    let wrapped' :: C_TextInsertAtCursorCallback
wrapped' = (a -> TextInsertAtCursorCallback) -> C_TextInsertAtCursorCallback
forall a.
GObject a =>
(a -> TextInsertAtCursorCallback) -> C_TextInsertAtCursorCallback
wrap_TextInsertAtCursorCallback a -> TextInsertAtCursorCallback
wrapped
    wrapped'' <- C_TextInsertAtCursorCallback
-> IO (FunPtr C_TextInsertAtCursorCallback)
mk_TextInsertAtCursorCallback C_TextInsertAtCursorCallback
wrapped'
    connectSignalFunPtr obj "insert-at-cursor" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextInsertAtCursor :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextInsertAtCursorCallback) -> m SignalHandlerId
afterTextInsertAtCursor :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a
-> ((?self::a) => TextInsertAtCursorCallback) -> m SignalHandlerId
afterTextInsertAtCursor a
obj (?self::a) => TextInsertAtCursorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TextInsertAtCursorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextInsertAtCursorCallback
TextInsertAtCursorCallback
cb
    let wrapped' :: C_TextInsertAtCursorCallback
wrapped' = (a -> TextInsertAtCursorCallback) -> C_TextInsertAtCursorCallback
forall a.
GObject a =>
(a -> TextInsertAtCursorCallback) -> C_TextInsertAtCursorCallback
wrap_TextInsertAtCursorCallback a -> TextInsertAtCursorCallback
wrapped
    wrapped'' <- C_TextInsertAtCursorCallback
-> IO (FunPtr C_TextInsertAtCursorCallback)
mk_TextInsertAtCursorCallback C_TextInsertAtCursorCallback
wrapped'
    connectSignalFunPtr obj "insert-at-cursor" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::insert-at-cursor"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:insertAtCursor"})

#endif

-- signal Text::insert-emoji
-- | Emitted to present the Emoji chooser.
-- 
-- This is a <https://docs.gtk.org/gtk4/class.SignalAction.html keybinding signal>.
-- 
-- The default bindings for this signal are
-- \<kbd>Ctrl\<\/kbd>+\<kbd>.\<\/kbd> and
-- \<kbd>Ctrl\<\/kbd>+\<kbd>;\<\/kbd>
type TextInsertEmojiCallback =
    IO ()

type C_TextInsertEmojiCallback =
    Ptr Text ->                             -- 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_TextInsertEmojiCallback :: 
    GObject a => (a -> TextInsertEmojiCallback) ->
    C_TextInsertEmojiCallback
wrap_TextInsertEmojiCallback :: forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextInsertEmojiCallback a -> IO ()
gi'cb Ptr Text
gi'selfPtr Ptr ()
_ = do
    Ptr Text -> (Text -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Text
gi'selfPtr ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
gi'self -> a -> IO ()
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self) 


-- | 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 -> ((?self :: a) => TextInsertEmojiCallback) -> m SignalHandlerId
onTextInsertEmoji :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTextInsertEmoji a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextInsertEmojiCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextInsertEmojiCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "insert-emoji" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextInsertEmoji :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextInsertEmojiCallback) -> m SignalHandlerId
afterTextInsertEmoji :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTextInsertEmoji a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextInsertEmojiCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextInsertEmojiCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "insert-emoji" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::insert-emoji"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:insertEmoji"})

#endif

-- signal Text::move-cursor
-- | 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.
-- 
-- This is a <https://docs.gtk.org/gtk4/class.SignalAction.html keybinding signal>.
-- 
-- Applications should not connect to it, but may emit it with
-- @/GObject.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 \<kbd>Shift\<\/kbd> modifier extends the
-- selection, the variant without it does not.
-- There are too many key combinations to list them all here.
-- 
-- * \<kbd>←\<\/kbd>, \<kbd>→\<\/kbd>, \<kbd>↑\<\/kbd>, \<kbd>↓\<\/kbd>
--   move by individual characters\/lines
-- * \<kbd>Ctrl\<\/kbd>+\<kbd>←\<\/kbd>, etc. move by words\/paragraphs
-- * \<kbd>Home\<\/kbd> and \<kbd>End\<\/kbd> move to the ends of the buffer
type TextMoveCursorCallback =
    Gtk.Enums.MovementStep
    -- ^ /@step@/: the granularity of the move
    -> Int32
    -- ^ /@count@/: the number of /@step@/ units to move
    -> Bool
    -- ^ /@extend@/: true if the move should extend the selection
    -> IO ()

type C_TextMoveCursorCallback =
    Ptr Text ->                             -- 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_TextMoveCursorCallback :: 
    GObject a => (a -> TextMoveCursorCallback) ->
    C_TextMoveCursorCallback
wrap_TextMoveCursorCallback :: forall a.
GObject a =>
(a -> TextMoveCursorCallback) -> C_TextMoveCursorCallback
wrap_TextMoveCursorCallback a -> TextMoveCursorCallback
gi'cb Ptr Text
gi'selfPtr CUInt
step Int32
count CInt
extend Ptr ()
_ = 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
/= CInt
0) CInt
extend
    Ptr Text -> (Text -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Text
gi'selfPtr ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
gi'self -> a -> TextMoveCursorCallback
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self)  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 -> ((?self :: a) => TextMoveCursorCallback) -> m SignalHandlerId
onTextMoveCursor :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => TextMoveCursorCallback) -> m SignalHandlerId
onTextMoveCursor a
obj (?self::a) => TextMoveCursorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TextMoveCursorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextMoveCursorCallback
TextMoveCursorCallback
cb
    let wrapped' :: C_TextMoveCursorCallback
wrapped' = (a -> TextMoveCursorCallback) -> C_TextMoveCursorCallback
forall a.
GObject a =>
(a -> TextMoveCursorCallback) -> C_TextMoveCursorCallback
wrap_TextMoveCursorCallback a -> TextMoveCursorCallback
wrapped
    wrapped'' <- C_TextMoveCursorCallback -> IO (FunPtr C_TextMoveCursorCallback)
mk_TextMoveCursorCallback C_TextMoveCursorCallback
wrapped'
    connectSignalFunPtr obj "move-cursor" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextMoveCursor :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextMoveCursorCallback) -> m SignalHandlerId
afterTextMoveCursor :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => TextMoveCursorCallback) -> m SignalHandlerId
afterTextMoveCursor a
obj (?self::a) => TextMoveCursorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TextMoveCursorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextMoveCursorCallback
TextMoveCursorCallback
cb
    let wrapped' :: C_TextMoveCursorCallback
wrapped' = (a -> TextMoveCursorCallback) -> C_TextMoveCursorCallback
forall a.
GObject a =>
(a -> TextMoveCursorCallback) -> C_TextMoveCursorCallback
wrap_TextMoveCursorCallback a -> TextMoveCursorCallback
wrapped
    wrapped'' <- C_TextMoveCursorCallback -> IO (FunPtr C_TextMoveCursorCallback)
mk_TextMoveCursorCallback C_TextMoveCursorCallback
wrapped'
    connectSignalFunPtr obj "move-cursor" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::move-cursor"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:moveCursor"})

#endif

-- signal Text::paste-clipboard
-- | Emitted to paste the contents of the clipboard.
-- 
-- This is a <https://docs.gtk.org/gtk4/class.SignalAction.html keybinding signal>.
-- 
-- The default bindings for this signal are
-- \<kbd>Ctrl\<\/kbd>+\<kbd>v\<\/kbd> and \<kbd>Shift\<\/kbd>+\<kbd>Insert\<\/kbd>.
type TextPasteClipboardCallback =
    IO ()

type C_TextPasteClipboardCallback =
    Ptr Text ->                             -- 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_TextPasteClipboardCallback :: 
    GObject a => (a -> TextPasteClipboardCallback) ->
    C_TextPasteClipboardCallback
wrap_TextPasteClipboardCallback :: forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextPasteClipboardCallback a -> IO ()
gi'cb Ptr Text
gi'selfPtr Ptr ()
_ = do
    Ptr Text -> (Text -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Text
gi'selfPtr ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
gi'self -> a -> IO ()
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self) 


-- | 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 -> ((?self :: a) => TextPasteClipboardCallback) -> m SignalHandlerId
onTextPasteClipboard :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTextPasteClipboard a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextPasteClipboardCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextPasteClipboardCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "paste-clipboard" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextPasteClipboard :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextPasteClipboardCallback) -> m SignalHandlerId
afterTextPasteClipboard :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTextPasteClipboard a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextPasteClipboardCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextPasteClipboardCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "paste-clipboard" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::paste-clipboard"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:pasteClipboard"})

#endif

-- signal Text::preedit-changed
-- | Emitted when the preedit text changes.
-- 
-- 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 ()

type C_TextPreeditChangedCallback =
    Ptr Text ->                             -- 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_TextPreeditChangedCallback :: 
    GObject a => (a -> TextPreeditChangedCallback) ->
    C_TextPreeditChangedCallback
wrap_TextPreeditChangedCallback :: forall a.
GObject a =>
(a -> TextInsertAtCursorCallback) -> C_TextInsertAtCursorCallback
wrap_TextPreeditChangedCallback a -> TextInsertAtCursorCallback
gi'cb Ptr Text
gi'selfPtr CString
preedit Ptr ()
_ = do
    preedit' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
preedit
    B.ManagedPtr.withNewObject gi'selfPtr $ \Text
gi'self -> a -> TextInsertAtCursorCallback
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self)  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 -> ((?self :: a) => TextPreeditChangedCallback) -> m SignalHandlerId
onTextPreeditChanged :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a
-> ((?self::a) => TextInsertAtCursorCallback) -> m SignalHandlerId
onTextPreeditChanged a
obj (?self::a) => TextInsertAtCursorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TextInsertAtCursorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextInsertAtCursorCallback
TextInsertAtCursorCallback
cb
    let wrapped' :: C_TextInsertAtCursorCallback
wrapped' = (a -> TextInsertAtCursorCallback) -> C_TextInsertAtCursorCallback
forall a.
GObject a =>
(a -> TextInsertAtCursorCallback) -> C_TextInsertAtCursorCallback
wrap_TextPreeditChangedCallback a -> TextInsertAtCursorCallback
wrapped
    wrapped'' <- C_TextInsertAtCursorCallback
-> IO (FunPtr C_TextInsertAtCursorCallback)
mk_TextPreeditChangedCallback C_TextInsertAtCursorCallback
wrapped'
    connectSignalFunPtr obj "preedit-changed" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextPreeditChanged :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextPreeditChangedCallback) -> m SignalHandlerId
afterTextPreeditChanged :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a
-> ((?self::a) => TextInsertAtCursorCallback) -> m SignalHandlerId
afterTextPreeditChanged a
obj (?self::a) => TextInsertAtCursorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TextInsertAtCursorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TextInsertAtCursorCallback
TextInsertAtCursorCallback
cb
    let wrapped' :: C_TextInsertAtCursorCallback
wrapped' = (a -> TextInsertAtCursorCallback) -> C_TextInsertAtCursorCallback
forall a.
GObject a =>
(a -> TextInsertAtCursorCallback) -> C_TextInsertAtCursorCallback
wrap_TextPreeditChangedCallback a -> TextInsertAtCursorCallback
wrapped
    wrapped'' <- C_TextInsertAtCursorCallback
-> IO (FunPtr C_TextInsertAtCursorCallback)
mk_TextPreeditChangedCallback C_TextInsertAtCursorCallback
wrapped'
    connectSignalFunPtr obj "preedit-changed" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::preedit-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:preeditChanged"})

#endif

-- signal Text::toggle-overwrite
-- | Emitted to toggle the overwrite mode.
-- 
-- This is a <https://docs.gtk.org/gtk4/class.SignalAction.html keybinding signal>.
-- 
-- The default bindings for this signal is \<kbd>Insert\<\/kbd>.
type TextToggleOverwriteCallback =
    IO ()

type C_TextToggleOverwriteCallback =
    Ptr Text ->                             -- 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_TextToggleOverwriteCallback :: 
    GObject a => (a -> TextToggleOverwriteCallback) ->
    C_TextToggleOverwriteCallback
wrap_TextToggleOverwriteCallback :: forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextToggleOverwriteCallback a -> IO ()
gi'cb Ptr Text
gi'selfPtr Ptr ()
_ = do
    Ptr Text -> (Text -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Text
gi'selfPtr ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
gi'self -> a -> IO ()
gi'cb (Text -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Text
gi'self) 


-- | 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 -> ((?self :: a) => TextToggleOverwriteCallback) -> m SignalHandlerId
onTextToggleOverwrite :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTextToggleOverwrite a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextToggleOverwriteCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextToggleOverwriteCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "toggle-overwrite" wrapped'' SignalConnectBefore 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTextToggleOverwrite :: (IsText a, MonadIO m) => a -> ((?self :: a) => TextToggleOverwriteCallback) -> m SignalHandlerId
afterTextToggleOverwrite :: forall a (m :: * -> *).
(IsText a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTextToggleOverwrite a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TextActivateCallback
wrapped' = (a -> IO ()) -> C_TextActivateCallback
forall a. GObject a => (a -> IO ()) -> C_TextActivateCallback
wrap_TextToggleOverwriteCallback a -> IO ()
wrapped
    wrapped'' <- C_TextActivateCallback -> IO (FunPtr C_TextActivateCallback)
mk_TextToggleOverwriteCallback C_TextActivateCallback
wrapped'
    connectSignalFunPtr obj "toggle-overwrite" wrapped'' SignalConnectAfter 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text::toggle-overwrite"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:signal:toggleOverwrite"})

#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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Bool
getTextActivatesDefault o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> Bool -> m ()
setTextActivatesDefault o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"activates-default" Bool
val

-- | Construct a t'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, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTextActivatesDefault :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTextActivatesDefault Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.activatesDefault"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:activatesDefault"
        })
#endif

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

-- | 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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> m (Maybe AttrList)
getTextAttributes o
obj = IO (Maybe AttrList) -> m (Maybe AttrList)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> AttrList -> m ()
setTextAttributes o
obj AttrList
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe AttrList -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"attributes" (AttrList -> Maybe AttrList
forall a. a -> Maybe a
Just AttrList
val)

-- | Construct a t'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, MIO.MonadIO m) => Pango.AttrList.AttrList -> m (GValueConstruct o)
constructTextAttributes :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
AttrList -> m (GValueConstruct o)
constructTextAttributes AttrList
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe AttrList -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"attributes" (AttrList -> Maybe AttrList
forall a. a -> Maybe a
P.Just AttrList
val)

-- | Set the value of the “@attributes@” 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' #attributes
-- @
clearTextAttributes :: (MonadIO m, IsText o) => o -> m ()
clearTextAttributes :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m ()
clearTextAttributes o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe AttrList -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"attributes" (Maybe AttrList
forall a. Maybe a
Nothing :: Maybe Pango.AttrList.AttrList)

#if defined(ENABLE_OVERLOADING)
data TextAttributesPropertyInfo
instance AttrInfo TextAttributesPropertyInfo where
    type AttrAllowedOps TextAttributesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    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 = clearTextAttributes
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.attributes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:attributes"
        })
#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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m EntryBuffer
getTextBuffer o
obj = IO EntryBuffer -> m EntryBuffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 Text
"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 String
"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 :: forall (m :: * -> *) o a.
(MonadIO m, IsText o, IsEntryBuffer a) =>
o -> a -> m ()
setTextBuffer o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"buffer" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'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, MIO.MonadIO m, Gtk.EntryBuffer.IsEntryBuffer a) => a -> m (GValueConstruct o)
constructTextBuffer :: forall o (m :: * -> *) a.
(IsText o, MonadIO m, IsEntryBuffer a) =>
a -> m (GValueConstruct o)
constructTextBuffer a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"buffer" (a -> Maybe a
forall a. a -> Maybe a
P.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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.buffer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:buffer"
        })
#endif

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

-- | 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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Bool
getTextEnableEmojiCompletion o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"enable-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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> Bool -> m ()
setTextEnableEmojiCompletion o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"enable-emoji-completion" Bool
val

-- | Construct a t'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, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTextEnableEmojiCompletion :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTextEnableEmojiCompletion Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.enableEmojiCompletion"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:enableEmojiCompletion"
        })
#endif

-- VVV Prop "extra-menu"
   -- Type: TInterface (Name {namespace = "Gio", name = "MenuModel"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@extra-menu@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' text [ #extraMenu 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextExtraMenu :: (MonadIO m, IsText o, Gio.MenuModel.IsMenuModel a) => o -> a -> m ()
setTextExtraMenu :: forall (m :: * -> *) o a.
(MonadIO m, IsText o, IsMenuModel a) =>
o -> a -> m ()
setTextExtraMenu o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"extra-menu" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@extra-menu@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextExtraMenu :: (IsText o, MIO.MonadIO m, Gio.MenuModel.IsMenuModel a) => a -> m (GValueConstruct o)
constructTextExtraMenu :: forall o (m :: * -> *) a.
(IsText o, MonadIO m, IsMenuModel a) =>
a -> m (GValueConstruct o)
constructTextExtraMenu a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"extra-menu" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@extra-menu@” 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' #extraMenu
-- @
clearTextExtraMenu :: (MonadIO m, IsText o) => o -> m ()
clearTextExtraMenu :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m ()
clearTextExtraMenu o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe MenuModel -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"extra-menu" (Maybe MenuModel
forall a. Maybe a
Nothing :: Maybe Gio.MenuModel.MenuModel)

#if defined(ENABLE_OVERLOADING)
data TextExtraMenuPropertyInfo
instance AttrInfo TextExtraMenuPropertyInfo where
    type AttrAllowedOps TextExtraMenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TextExtraMenuPropertyInfo = IsText
    type AttrSetTypeConstraint TextExtraMenuPropertyInfo = Gio.MenuModel.IsMenuModel
    type AttrTransferTypeConstraint TextExtraMenuPropertyInfo = Gio.MenuModel.IsMenuModel
    type AttrTransferType TextExtraMenuPropertyInfo = Gio.MenuModel.MenuModel
    type AttrGetType TextExtraMenuPropertyInfo = (Maybe Gio.MenuModel.MenuModel)
    type AttrLabel TextExtraMenuPropertyInfo = "extra-menu"
    type AttrOrigin TextExtraMenuPropertyInfo = Text
    attrGet = getTextExtraMenu
    attrSet = setTextExtraMenu
    attrTransfer _ v = do
        unsafeCastTo Gio.MenuModel.MenuModel v
    attrConstruct = constructTextExtraMenu
    attrClear = clearTextExtraMenu
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.extraMenu"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:extraMenu"
        })
#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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> m (Maybe Text)
getTextImModule o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> Text -> m ()
setTextImModule o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"im-module" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a t'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, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructTextImModule :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructTextImModule Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"im-module" (Text -> Maybe Text
forall a. a -> Maybe a
P.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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m ()
clearTextImModule o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.imModule"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:imModule"
        })
#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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> m [InputHints]
getTextInputHints o
obj = IO [InputHints] -> m [InputHints]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> [InputHints] -> m ()
setTextInputHints o
obj [InputHints]
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> [InputHints] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"input-hints" [InputHints]
val

-- | Construct a t'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, MIO.MonadIO m) => [Gtk.Flags.InputHints] -> m (GValueConstruct o)
constructTextInputHints :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
[InputHints] -> m (GValueConstruct o)
constructTextInputHints [InputHints]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [InputHints] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.inputHints"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:inputHints"
        })
#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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> m InputPurpose
getTextInputPurpose o
obj = IO InputPurpose -> m InputPurpose
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> InputPurpose -> m ()
setTextInputPurpose o
obj InputPurpose
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> InputPurpose -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"input-purpose" InputPurpose
val

-- | Construct a t'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, MIO.MonadIO m) => Gtk.Enums.InputPurpose -> m (GValueConstruct o)
constructTextInputPurpose :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
InputPurpose -> m (GValueConstruct o)
constructTextInputPurpose InputPurpose
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> InputPurpose -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.inputPurpose"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:inputPurpose"
        })
#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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Word32
getTextInvisibleChar o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> Word32 -> m ()
setTextInvisibleChar o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"invisible-char" Word32
val

-- | Construct a t'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, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructTextInvisibleChar :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructTextInvisibleChar Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.invisibleChar"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:invisibleChar"
        })
#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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Bool
getTextInvisibleCharSet o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> Bool -> m ()
setTextInvisibleCharSet o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"invisible-char-set" Bool
val

-- | Construct a t'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, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTextInvisibleCharSet :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTextInvisibleCharSet Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.invisibleCharSet"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:invisibleCharSet"
        })
#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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Int32
getTextMaxLength o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"max-length"

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

-- | Construct a t'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, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructTextMaxLength :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructTextMaxLength Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"max-length" Int32
val

#if defined(ENABLE_OVERLOADING)
data 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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.maxLength"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:maxLength"
        })
#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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Bool
getTextOverwriteMode o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> Bool -> m ()
setTextOverwriteMode o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"overwrite-mode" Bool
val

-- | Construct a t'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, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTextOverwriteMode :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTextOverwriteMode Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.overwriteMode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:overwriteMode"
        })
#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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> m (Maybe Text)
getTextPlaceholderText o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> Text -> m ()
setTextPlaceholderText o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"placeholder-text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a t'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, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructTextPlaceholderText :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructTextPlaceholderText Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"placeholder-text" (Text -> Maybe Text
forall a. a -> Maybe a
P.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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m ()
clearTextPlaceholderText o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.placeholderText"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:placeholderText"
        })
#endif

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

-- | 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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Bool
getTextPropagateTextWidth o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> Bool -> m ()
setTextPropagateTextWidth o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"propagate-text-width" Bool
val

-- | Construct a t'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, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTextPropagateTextWidth :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTextPropagateTextWidth Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.propagateTextWidth"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:propagateTextWidth"
        })
#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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Int32
getTextScrollOffset o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.scrollOffset"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:scrollOffset"
        })
#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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> m (Maybe TabArray)
getTextTabs o
obj = IO (Maybe TabArray) -> m (Maybe TabArray)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsText o) =>
o -> TabArray -> m ()
setTextTabs o
obj TabArray
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe TabArray -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"tabs" (TabArray -> Maybe TabArray
forall a. a -> Maybe a
Just TabArray
val)

-- | Construct a t'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, MIO.MonadIO m) => Pango.TabArray.TabArray -> m (GValueConstruct o)
constructTextTabs :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
TabArray -> m (GValueConstruct o)
constructTextTabs TabArray
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe TabArray -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"tabs" (TabArray -> Maybe TabArray
forall a. a -> Maybe a
P.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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m ()
clearTextTabs o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe TabArray -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.tabs"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:tabs"
        })
#endif

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

-- | 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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Bool
getTextTruncateMultiline o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> Bool -> m ()
setTextTruncateMultiline o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"truncate-multiline" Bool
val

-- | Construct a t'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, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTextTruncateMultiline :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTextTruncateMultiline Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.truncateMultiline"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:truncateMultiline"
        })
#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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> m Bool
getTextVisibility o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"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 :: forall (m :: * -> *) o. (MonadIO m, IsText o) => o -> Bool -> m ()
setTextVisibility o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"visibility" Bool
val

-- | Construct a t'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, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTextVisibility :: forall o (m :: * -> *).
(IsText o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTextVisibility Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.visibility"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#g:attr:visibility"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Text
type instance O.AttributeList Text = TextAttributeList
type TextAttributeList = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("activatesDefault", TextActivatesDefaultPropertyInfo), '("attributes", TextAttributesPropertyInfo), '("buffer", TextBufferPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("cursorPosition", Gtk.Editable.EditableCursorPositionPropertyInfo), '("editable", Gtk.Editable.EditableEditablePropertyInfo), '("enableEmojiCompletion", TextEnableEmojiCompletionPropertyInfo), '("enableUndo", Gtk.Editable.EditableEnableUndoPropertyInfo), '("extraMenu", TextExtraMenuPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("imModule", TextImModulePropertyInfo), '("inputHints", TextInputHintsPropertyInfo), '("inputPurpose", TextInputPurposePropertyInfo), '("invisibleChar", TextInvisibleCharPropertyInfo), '("invisibleCharSet", TextInvisibleCharSetPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("limitEvents", Gtk.Widget.WidgetLimitEventsPropertyInfo), '("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), '("propagateTextWidth", TextPropagateTextWidthPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("scrollOffset", TextScrollOffsetPropertyInfo), '("selectionBound", Gtk.Editable.EditableSelectionBoundPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("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, DK.Type)])
#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

textExtraMenu :: AttrLabelProxy "extraMenu"
textExtraMenu = 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

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 = ('[ '("activate", TextActivateSignalInfo), '("backspace", TextBackspaceSignalInfo), '("changed", Gtk.Editable.EditableChangedSignalInfo), '("copyClipboard", TextCopyClipboardSignalInfo), '("cutClipboard", TextCutClipboardSignalInfo), '("deleteFromCursor", TextDeleteFromCursorSignalInfo), '("deleteText", Gtk.Editable.EditableDeleteTextSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("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), '("preeditChanged", TextPreeditChangedSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("toggleOverwrite", TextToggleOverwriteSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, DK.Type)])

#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 @GtkText@.
textNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Text
    -- ^ __Returns:__ the new @GtkText@
textNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Text
textNew  = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    result <- IO (Ptr Text)
gtk_text_new
    checkUnexpectedReturnNULL "textNew" result
    result' <- (newObject Text) result
    return 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 @GtkText@ with the specified buffer.
textNewWithBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.EntryBuffer.IsEntryBuffer a) =>
    a
    -- ^ /@buffer@/: the buffer to use
    -> m Text
    -- ^ __Returns:__ a new @GtkText@
textNewWithBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntryBuffer a) =>
a -> m Text
textNewWithBuffer a
buffer = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    buffer' <- a -> IO (Ptr EntryBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    result <- gtk_text_new_with_buffer buffer'
    checkUnexpectedReturnNULL "textNewWithBuffer" result
    result' <- (newObject Text) result
    touchManagedPtr buffer
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Text::compute_cursor_extents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the character position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "strong"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the strong cursor position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "weak"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the weak cursor position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_compute_cursor_extents" gtk_text_compute_cursor_extents :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    FCT.CSize ->                            -- position : TBasicType TSize
    Ptr Graphene.Rect.Rect ->               -- strong : TInterface (Name {namespace = "Graphene", name = "Rect"})
    Ptr Graphene.Rect.Rect ->               -- weak : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO ()

-- | Determines the positions of the strong and weak cursors for a
-- given character position.
-- 
-- The position of each cursor is stored as a zero-width rectangle.
-- The strong cursor location is the location where characters of
-- the directionality equal to the base direction are inserted.
-- The weak cursor location is the location where characters of
-- the directionality opposite to the base direction are inserted.
-- 
-- The rectangle positions are in widget coordinates.
-- 
-- /Since: 4.4/
textComputeCursorExtents ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> FCT.CSize
    -- ^ /@position@/: the character position
    -> m ((Graphene.Rect.Rect, Graphene.Rect.Rect))
textComputeCursorExtents :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> CSize -> m (Rect, Rect)
textComputeCursorExtents a
self CSize
position = IO (Rect, Rect) -> m (Rect, Rect)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Rect, Rect) -> m (Rect, Rect))
-> IO (Rect, Rect) -> m (Rect, Rect)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    strong <- SP.callocBoxedBytes 16 :: IO (Ptr Graphene.Rect.Rect)
    weak <- SP.callocBoxedBytes 16 :: IO (Ptr Graphene.Rect.Rect)
    gtk_text_compute_cursor_extents self' position strong weak
    strong' <- (wrapBoxed Graphene.Rect.Rect) strong
    weak' <- (wrapBoxed Graphene.Rect.Rect) weak
    touchManagedPtr self
    return (strong', weak')

#if defined(ENABLE_OVERLOADING)
data TextComputeCursorExtentsMethodInfo
instance (signature ~ (FCT.CSize -> m ((Graphene.Rect.Rect, Graphene.Rect.Rect))), MonadIO m, IsText a) => O.OverloadedMethod TextComputeCursorExtentsMethodInfo a signature where
    overloadedMethod = textComputeCursorExtents

instance O.OverloadedMethodInfo TextComputeCursorExtentsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textComputeCursorExtents",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textComputeCursorExtents"
        })


#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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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

-- | Returns whether pressing \<kbd>Enter\<\/kbd> will activate
-- the default widget for the window containing the widget.
-- 
-- See 'GI.Gtk.Objects.Text.textSetActivatesDefault'.
textGetActivatesDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Bool
    -- ^ __Returns:__ true if /@self@/ will activate the default widget
textGetActivatesDefault :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Bool
textGetActivatesDefault a
self = IO Bool -> m Bool
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_activates_default self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return result'

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

instance O.OverloadedMethodInfo TextGetActivatesDefaultMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetActivatesDefault",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 text widget.
-- 
-- See 'GI.Gtk.Objects.Text.textSetAttributes'.
textGetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m (Maybe Pango.AttrList.AttrList)
    -- ^ __Returns:__ the attribute list
textGetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m (Maybe AttrList)
textGetAttributes a
self = IO (Maybe AttrList) -> m (Maybe AttrList)
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_attributes self'
    maybeResult <- convertIfNonNull result $ \Ptr AttrList
result' -> do
        result'' <- ((ManagedPtr AttrList -> AttrList) -> Ptr AttrList -> IO AttrList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr AttrList -> AttrList
Pango.AttrList.AttrList) Ptr AttrList
result'
        return result''
    touchManagedPtr self
    return maybeResult

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

instance O.OverloadedMethodInfo TextGetAttributesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetAttributes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 entry buffer object which holds the text for
-- this widget.
textGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Gtk.EntryBuffer.EntryBuffer
    -- ^ __Returns:__ the entry buffer object
textGetBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m EntryBuffer
textGetBuffer a
self = IO EntryBuffer -> m EntryBuffer
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_buffer self'
    checkUnexpectedReturnNULL "textGetBuffer" result
    result' <- (newObject Gtk.EntryBuffer.EntryBuffer) result
    touchManagedPtr self
    return result'

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

instance O.OverloadedMethodInfo TextGetBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textGetBuffer"
        })


#endif

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

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

-- | Returns whether Emoji completion is enabled.
textGetEnableEmojiCompletion ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Bool
    -- ^ __Returns:__ true if Emoji completion is enabled
textGetEnableEmojiCompletion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Bool
textGetEnableEmojiCompletion a
self = IO Bool -> m Bool
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_enable_emoji_completion self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data TextGetEnableEmojiCompletionMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsText a) => O.OverloadedMethod TextGetEnableEmojiCompletionMethodInfo a signature where
    overloadedMethod = textGetEnableEmojiCompletion

instance O.OverloadedMethodInfo TextGetEnableEmojiCompletionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetEnableEmojiCompletion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textGetEnableEmojiCompletion"
        })


#endif

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

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

-- | Gets the extra menu model of the text widget.
-- 
-- See 'GI.Gtk.Objects.Text.textSetExtraMenu'.
textGetExtraMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m (Maybe Gio.MenuModel.MenuModel)
    -- ^ __Returns:__ the menu model
textGetExtraMenu :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m (Maybe MenuModel)
textGetExtraMenu a
self = IO (Maybe MenuModel) -> m (Maybe MenuModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MenuModel) -> m (Maybe MenuModel))
-> IO (Maybe MenuModel) -> m (Maybe MenuModel)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_extra_menu self'
    maybeResult <- convertIfNonNull result $ \Ptr MenuModel
result' -> do
        result'' <- ((ManagedPtr MenuModel -> MenuModel)
-> Ptr MenuModel -> IO MenuModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr MenuModel -> MenuModel
Gio.MenuModel.MenuModel) Ptr MenuModel
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data TextGetExtraMenuMethodInfo
instance (signature ~ (m (Maybe Gio.MenuModel.MenuModel)), MonadIO m, IsText a) => O.OverloadedMethod TextGetExtraMenuMethodInfo a signature where
    overloadedMethod = textGetExtraMenu

instance O.OverloadedMethodInfo TextGetExtraMenuMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetExtraMenu",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textGetExtraMenu"
        })


#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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 input hints of the text widget.
textGetInputHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m [Gtk.Flags.InputHints]
    -- ^ __Returns:__ the input hints
textGetInputHints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m [InputHints]
textGetInputHints a
self = IO [InputHints] -> m [InputHints]
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_input_hints self'
    let result' = CUInt -> [InputHints]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    touchManagedPtr self
    return result'

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

instance O.OverloadedMethodInfo TextGetInputHintsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetInputHints",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 input purpose of the text widget.
textGetInputPurpose ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Gtk.Enums.InputPurpose
    -- ^ __Returns:__ the input purpose
textGetInputPurpose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m InputPurpose
textGetInputPurpose a
self = IO InputPurpose -> m InputPurpose
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_input_purpose self'
    let 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
    touchManagedPtr self
    return result'

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

instance O.OverloadedMethodInfo TextGetInputPurposeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetInputPurpose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 when visibility is set to false.
-- 
-- Note that GTK does not compute this value unless it needs it,
-- so the value returned by this function is not very useful unless
-- it has been explicitly set with 'GI.Gtk.Objects.Text.textSetInvisibleChar'.
textGetInvisibleChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Char
    -- ^ __Returns:__ the current invisible char, or 0, if /@text@/ does not
    --   show invisible text at all
textGetInvisibleChar :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Char
textGetInvisibleChar a
self = IO Char -> m Char
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_invisible_char self'
    let 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
    touchManagedPtr self
    return result'

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

instance O.OverloadedMethodInfo TextGetInvisibleCharMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetInvisibleChar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 contents.
-- 
-- See 'GI.Gtk.Objects.Text.textSetMaxLength'.
-- 
-- This is equivalent to getting /@self@/\'s @GtkEntryBuffer@ and
-- calling 'GI.Gtk.Objects.EntryBuffer.entryBufferGetMaxLength' on it.
textGetMaxLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Int32
    -- ^ __Returns:__ the maximum allowed number of characters, or 0 if
    --   there is no limit
textGetMaxLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Int32
textGetMaxLength a
self = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_max_length self'
    touchManagedPtr self
    return result

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

instance O.OverloadedMethodInfo TextGetMaxLengthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetMaxLength",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 whether text is overwritten when typing.
-- 
-- See 'GI.Gtk.Objects.Text.textSetOverwriteMode'.
textGetOverwriteMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Bool
    -- ^ __Returns:__ whether text is overwritten when typing
textGetOverwriteMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Bool
textGetOverwriteMode a
self = IO Bool -> m Bool
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_overwrite_mode self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return result'

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

instance O.OverloadedMethodInfo TextGetOverwriteModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetOverwriteMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 the text widget
-- is empty and unfocused
-- 
-- See 'GI.Gtk.Objects.Text.textSetPlaceholderText'.
textGetPlaceholderText ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the placeholder text
textGetPlaceholderText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m (Maybe Text)
textGetPlaceholderText a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_placeholder_text self'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr self
    return maybeResult

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

instance O.OverloadedMethodInfo TextGetPlaceholderTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetPlaceholderText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textGetPlaceholderText"
        })


#endif

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

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

-- | Returns whether the text widget will grow and shrink
-- with the content.
textGetPropagateTextWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Bool
    -- ^ __Returns:__ true if /@self@/ will propagate the text width
textGetPropagateTextWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Bool
textGetPropagateTextWidth a
self = IO Bool -> m Bool
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_propagate_text_width self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data TextGetPropagateTextWidthMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsText a) => O.OverloadedMethod TextGetPropagateTextWidthMethodInfo a signature where
    overloadedMethod = textGetPropagateTextWidth

instance O.OverloadedMethodInfo TextGetPropagateTextWidthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetPropagateTextWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textGetPropagateTextWidth"
        })


#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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 tab stops for the text widget.
-- 
-- See 'GI.Gtk.Objects.Text.textSetTabs'.
textGetTabs ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m (Maybe Pango.TabArray.TabArray)
    -- ^ __Returns:__ the tab stops
textGetTabs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m (Maybe TabArray)
textGetTabs a
self = IO (Maybe TabArray) -> m (Maybe TabArray)
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_tabs self'
    maybeResult <- convertIfNonNull result $ \Ptr TabArray
result' -> do
        result'' <- ((ManagedPtr TabArray -> TabArray) -> Ptr TabArray -> IO TabArray
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TabArray -> TabArray
Pango.TabArray.TabArray) Ptr TabArray
result'
        return result''
    touchManagedPtr self
    return maybeResult

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

instance O.OverloadedMethodInfo TextGetTabsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetTabs",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 length of the contents.
-- 
-- This is equivalent to getting /@self@/\'s @GtkEntryBuffer@
-- and calling 'GI.Gtk.Objects.EntryBuffer.entryBufferGetLength' on it.
textGetTextLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Word16
    -- ^ __Returns:__ the length of the contents, in characters
textGetTextLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Word16
textGetTextLength a
self = IO Word16 -> m Word16
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_text_length self'
    touchManagedPtr self
    return result

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

instance O.OverloadedMethodInfo TextGetTextLengthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetTextLength",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textGetTextLength"
        })


#endif

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

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

-- | Returns whether pasted text will be truncated to the first line.
textGetTruncateMultiline ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Bool
    -- ^ __Returns:__ true if /@self@/ will truncate pasted multi-line text
textGetTruncateMultiline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Bool
textGetTruncateMultiline a
self = IO Bool -> m Bool
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_truncate_multiline self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data TextGetTruncateMultilineMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsText a) => O.OverloadedMethod TextGetTruncateMultilineMethodInfo a signature where
    overloadedMethod = textGetTruncateMultiline

instance O.OverloadedMethodInfo TextGetTruncateMultilineMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetTruncateMultiline",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textGetTruncateMultiline"
        })


#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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 is visible.
textGetVisibility ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m Bool
    -- ^ __Returns:__ true if the text is visible
textGetVisibility :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Bool
textGetVisibility a
self = IO Bool -> m Bool
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_get_visibility self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return result'

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

instance O.OverloadedMethodInfo TextGetVisibilityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGetVisibility",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- 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 CInt

-- | Causes the text widget to have the keyboard focus.
-- 
-- It behaves like 'GI.Gtk.Objects.Widget.widgetGrabFocus',
-- except that it does not select the contents of /@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 text widget
    -> m Bool
    -- ^ __Returns:__ true if focus is now inside /@self@/
textGrabFocusWithoutSelecting :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Bool
textGrabFocusWithoutSelecting a
self = IO Bool -> m Bool
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_text_grab_focus_without_selecting self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return result'

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

instance O.OverloadedMethodInfo TextGrabFocusWithoutSelectingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textGrabFocusWithoutSelecting",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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\n  <kbd>Enter</kbd> keypress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 ()

-- | Sets whether pressing \<kbd>Enter\<\/kbd> will activate
-- the default widget.
-- 
-- This usually means that the dialog containing /@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 text widget
    -> Bool
    -- ^ /@activates@/: true to activate window’s default widget on
    --   \<kbd>Enter\<\/kbd> keypress
    -> m ()
textSetActivatesDefault :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Bool -> m ()
textSetActivatesDefault a
self Bool
activates = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let activates' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
activates
    gtk_text_set_activates_default self' activates'
    touchManagedPtr self
    return ()

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

instance O.OverloadedMethodInfo TextSetActivatesDefaultMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetActivatesDefault",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attrs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a list of style attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 ()

-- | Apply attributes to the contents of the text widget.
textSetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> Maybe (Pango.AttrList.AttrList)
    -- ^ /@attrs@/: a list of style attributes
    -> m ()
textSetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Maybe AttrList -> m ()
textSetAttributes a
self Maybe AttrList
attrs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeAttrs <- case attrs of
        Maybe AttrList
Nothing -> Ptr AttrList -> IO (Ptr AttrList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AttrList
forall a. Ptr a
FP.nullPtr
        Just AttrList
jAttrs -> do
            jAttrs' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
jAttrs
            return jAttrs'
    gtk_text_set_attributes self' maybeAttrs
    touchManagedPtr self
    whenJust attrs touchManagedPtr
    return ()

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

instance O.OverloadedMethodInfo TextSetAttributesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetAttributes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an entry buffer object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 entry buffer object which holds the text for
-- this widget.
textSetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a, Gtk.EntryBuffer.IsEntryBuffer b) =>
    a
    -- ^ /@self@/: a text widget
    -> b
    -- ^ /@buffer@/: an entry buffer object
    -> m ()
textSetBuffer :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsText a, IsEntryBuffer b) =>
a -> b -> m ()
textSetBuffer a
self b
buffer = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    buffer' <- unsafeManagedPtrCastPtr buffer
    gtk_text_set_buffer self' buffer'
    touchManagedPtr self
    touchManagedPtr buffer
    return ()

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

instance O.OverloadedMethodInfo TextSetBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textSetBuffer"
        })


#endif

-- method Text::set_enable_emoji_completion
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enable_emoji_completion"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "true to enable Emoji completion"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether Emoji completion is enabled.
-- 
-- If it is, typing \':\', followed by a recognized keyword,
-- will pop up a window with suggested Emojis matching the
-- keyword.
textSetEnableEmojiCompletion ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> Bool
    -- ^ /@enableEmojiCompletion@/: true to enable Emoji completion
    -> m ()
textSetEnableEmojiCompletion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Bool -> m ()
textSetEnableEmojiCompletion a
self Bool
enableEmojiCompletion = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let enableEmojiCompletion' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
enableEmojiCompletion
    gtk_text_set_enable_emoji_completion self' enableEmojiCompletion'
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data TextSetEnableEmojiCompletionMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsText a) => O.OverloadedMethod TextSetEnableEmojiCompletionMethodInfo a signature where
    overloadedMethod = textSetEnableEmojiCompletion

instance O.OverloadedMethodInfo TextSetEnableEmojiCompletionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetEnableEmojiCompletion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textSetEnableEmojiCompletion"
        })


#endif

-- method Text::set_extra_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a menu model" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_text_set_extra_menu" gtk_text_set_extra_menu :: 
    Ptr Text ->                             -- self : TInterface (Name {namespace = "Gtk", name = "Text"})
    Ptr Gio.MenuModel.MenuModel ->          -- model : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Sets a menu model to add to the context menu of the text widget.
textSetExtraMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@self@/: a text widget
    -> Maybe (b)
    -- ^ /@model@/: a menu model
    -> m ()
textSetExtraMenu :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsText a, IsMenuModel b) =>
a -> Maybe b -> m ()
textSetExtraMenu a
self Maybe b
model = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeModel <- case model of
        Maybe b
Nothing -> Ptr MenuModel -> IO (Ptr MenuModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MenuModel
forall a. Ptr a
FP.nullPtr
        Just b
jModel -> do
            jModel' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jModel
            return jModel'
    gtk_text_set_extra_menu self' maybeModel
    touchManagedPtr self
    whenJust model touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data TextSetExtraMenuMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsText a, Gio.MenuModel.IsMenuModel b) => O.OverloadedMethod TextSetExtraMenuMethodInfo a signature where
    overloadedMethod = textSetExtraMenu

instance O.OverloadedMethodInfo TextSetExtraMenuMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetExtraMenu",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textSetExtraMenu"
        })


#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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hints"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "InputHints" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input hints" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 hints that allow input methods to fine-tune their behaviour.
textSetInputHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> [Gtk.Flags.InputHints]
    -- ^ /@hints@/: input hints
    -> m ()
textSetInputHints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> [InputHints] -> m ()
textSetInputHints a
self [InputHints]
hints = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let hints' = [InputHints] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [InputHints]
hints
    gtk_text_set_input_hints self' hints'
    touchManagedPtr self
    return ()

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

instance O.OverloadedMethodInfo TextSetInputHintsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetInputHints",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "purpose"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "InputPurpose" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the input purpose" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 input purpose of the text widget.
-- 
-- The input purpose 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 text widget
    -> Gtk.Enums.InputPurpose
    -- ^ /@purpose@/: the input purpose
    -> m ()
textSetInputPurpose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> InputPurpose -> m ()
textSetInputPurpose a
self InputPurpose
purpose = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let 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
    gtk_text_set_input_purpose self' purpose'
    touchManagedPtr self
    return ()

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

instance O.OverloadedMethodInfo TextSetInputPurposeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetInputPurpose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 when in “password mode”.
-- 
-- 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 text widget
    -> Char
    -- ^ /@ch@/: a Unicode character
    -> m ()
textSetInvisibleChar :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Char -> m ()
textSetInvisibleChar a
self Char
ch = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let ch' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
SP.ord) Char
ch
    gtk_text_set_invisible_char self' ch'
    touchManagedPtr self
    return ()

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

instance O.OverloadedMethodInfo TextSetInvisibleCharMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetInvisibleChar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the maximum length of the text, or 0 for no maximum.\n  (other than the maximum length of entries.) The value passed\n  in will be clamped to the range 0-65536"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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.
-- 
-- If the current contents are longer than the given length,
-- they will be truncated to fit.
-- 
-- This is equivalent to getting /@self@/\'s @GtkEntryBuffer@ and
-- calling 'GI.Gtk.Objects.EntryBuffer.entryBufferSetMaxLength' on it.
textSetMaxLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> Int32
    -- ^ /@length@/: the maximum length of the text, 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Int32 -> m ()
textSetMaxLength a
self Int32
length_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    gtk_text_set_max_length self' length_
    touchManagedPtr self
    return ()

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

instance O.OverloadedMethodInfo TextSetMaxLengthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetMaxLength",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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.
textSetOverwriteMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> Bool
    -- ^ /@overwrite@/: new value
    -> m ()
textSetOverwriteMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Bool -> m ()
textSetOverwriteMode a
self Bool
overwrite = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let overwrite' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
overwrite
    gtk_text_set_overwrite_mode self' overwrite'
    touchManagedPtr self
    return ()

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

instance O.OverloadedMethodInfo TextSetOverwriteModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetOverwriteMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a string to be displayed when @self\n  is empty and unfocused"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 the text to be displayed when the text widget is
-- empty and unfocused.
-- 
-- This can be used to give a visual hint of the expected
-- contents of the text widget.
textSetPlaceholderText ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> Maybe (T.Text)
    -- ^ /@text@/: a string to be displayed when /@self@/
    --   is empty and unfocused
    -> m ()
textSetPlaceholderText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Maybe Text -> m ()
textSetPlaceholderText a
self Maybe Text
text = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeText <- case text of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jText -> do
            jText' <- Text -> IO CString
textToCString Text
jText
            return jText'
    gtk_text_set_placeholder_text self' maybeText
    touchManagedPtr self
    freeMem maybeText
    return ()

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

instance O.OverloadedMethodInfo TextSetPlaceholderTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetPlaceholderText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textSetPlaceholderText"
        })


#endif

-- method Text::set_propagate_text_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "propagate_text_width"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "true to propagate the text width"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether the text widget should grow and shrink with the content.
textSetPropagateTextWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> Bool
    -- ^ /@propagateTextWidth@/: true to propagate the text width
    -> m ()
textSetPropagateTextWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Bool -> m ()
textSetPropagateTextWidth a
self Bool
propagateTextWidth = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let propagateTextWidth' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
propagateTextWidth
    gtk_text_set_propagate_text_width self' propagateTextWidth'
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data TextSetPropagateTextWidthMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsText a) => O.OverloadedMethod TextSetPropagateTextWidthMethodInfo a signature where
    overloadedMethod = textSetPropagateTextWidth

instance O.OverloadedMethodInfo TextSetPropagateTextWidthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetPropagateTextWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textSetPropagateTextWidth"
        })


#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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tabs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "TabArray" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tab stops" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 tab stops for the text widget.
textSetTabs ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> Maybe (Pango.TabArray.TabArray)
    -- ^ /@tabs@/: tab stops
    -> m ()
textSetTabs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Maybe TabArray -> m ()
textSetTabs a
self Maybe TabArray
tabs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeTabs <- case tabs of
        Maybe TabArray
Nothing -> Ptr TabArray -> IO (Ptr TabArray)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TabArray
forall a. Ptr a
FP.nullPtr
        Just TabArray
jTabs -> do
            jTabs' <- TabArray -> IO (Ptr TabArray)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TabArray
jTabs
            return jTabs'
    gtk_text_set_tabs self' maybeTabs
    touchManagedPtr self
    whenJust tabs touchManagedPtr
    return ()

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

instance O.OverloadedMethodInfo TextSetTabsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetTabs",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textSetTabs"
        })


#endif

-- method Text::set_truncate_multiline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "truncate_multiline"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "true to truncate multi-line text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether pasted text should be truncated to the first line.
textSetTruncateMultiline ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> Bool
    -- ^ /@truncateMultiline@/: true to truncate multi-line text
    -> m ()
textSetTruncateMultiline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Bool -> m ()
textSetTruncateMultiline a
self Bool
truncateMultiline = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let truncateMultiline' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
truncateMultiline
    gtk_text_set_truncate_multiline self' truncateMultiline'
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data TextSetTruncateMultilineMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsText a) => O.OverloadedMethod TextSetTruncateMultilineMethodInfo a signature where
    overloadedMethod = textSetTruncateMultiline

instance O.OverloadedMethodInfo TextSetTruncateMultilineMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetTruncateMultiline",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textSetTruncateMultiline"
        })


#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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "visible"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "true if the contents of the text widget are displayed\n  as plain text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 text widget are visible or not.
-- 
-- When visibility is set to false, characters are displayed
-- as the invisible char, and it will also appear that way when
-- the text in the 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 [Text:inputPurpose]("GI.Gtk.Objects.Text#g:attr:inputPurpose")
-- to 'GI.Gtk.Enums.InputPurposePassword' or 'GI.Gtk.Enums.InputPurposePin'
-- to inform input methods about the purpose of this widget, in addition
-- to setting visibility to false.
textSetVisibility ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> Bool
    -- ^ /@visible@/: true if the contents of the text widget are displayed
    --   as plain text
    -> m ()
textSetVisibility :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Bool -> m ()
textSetVisibility a
self Bool
visible = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let visible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
visible
    gtk_text_set_visibility self' visible'
    touchManagedPtr self
    return ()

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

instance O.OverloadedMethodInfo TextSetVisibilityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textSetVisibility",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v: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 text widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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.
-- 
-- After calling this, the default invisible char is used again.
textUnsetInvisibleChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@self@/: a text widget
    -> m ()
textUnsetInvisibleChar :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m ()
textUnsetInvisibleChar a
self = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    gtk_text_unset_invisible_char self'
    touchManagedPtr self
    return ()

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

instance O.OverloadedMethodInfo TextUnsetInvisibleCharMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Text.textUnsetInvisibleChar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Text.html#v:textUnsetInvisibleChar"
        })


#endif