{-# 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 widget.
-- 
-- \<picture>
--   \<source srcset=\"entry-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img alt=\"An example GtkEntry\" src=\"entry.png\">
-- \<\/picture>
-- 
-- A fairly large set of key bindings are supported by default. If the
-- entered text is longer than the allocation of the widget, the widget
-- will scroll so that the cursor position is visible.
-- 
-- When using an entry for passwords and other sensitive information, it
-- can be put into “password mode” using 'GI.Gtk.Objects.Entry.entrySetVisibility'.
-- In this mode, entered text is displayed using a “invisible” character.
-- By default, GTK picks the best invisible character that is available
-- in the current font, but it can be changed with
-- 'GI.Gtk.Objects.Entry.entrySetInvisibleChar'.
-- 
-- @GtkEntry@ has the ability to display progress or activity
-- information behind the text. To make an entry display such information,
-- use 'GI.Gtk.Objects.Entry.entrySetProgressFraction' or
-- 'GI.Gtk.Objects.Entry.entrySetProgressPulseStep'.
-- 
-- Additionally, @GtkEntry@ can show icons at either side of the entry.
-- These icons can be activatable by clicking, can be set up as drag source
-- and can have tooltips. To add an icon, use
-- 'GI.Gtk.Objects.Entry.entrySetIconFromGicon' or one of the various other functions
-- that set an icon from an icon name or a paintable. To trigger an action when
-- the user clicks an icon, connect to the [Entry::iconPress]("GI.Gtk.Objects.Entry#g:signal:iconPress") signal.
-- To allow DND operations from an icon, use
-- 'GI.Gtk.Objects.Entry.entrySetIconDragSource'. To set a tooltip on an icon, use
-- 'GI.Gtk.Objects.Entry.entrySetIconTooltipText' or the corresponding function
-- for markup.
-- 
-- Note that functionality or information that is only available by clicking
-- on an icon in an entry may not be accessible at all to users which are not
-- able to use a mouse or other pointing device. It is therefore recommended
-- that any such functionality should also be available by other means, e.g.
-- via the context menu of the entry.
-- 
-- = CSS nodes
-- 
-- 
-- 	
-- >entry[.flat][.warning][.error]
-- >├── text[.readonly]
-- >├── image.left
-- >├── image.right
-- >╰── [progress[.pulse]]
-- 
-- 
-- @GtkEntry@ has a main node with the name entry. Depending on the properties
-- of the entry, the style classes .read-only and .flat may appear. The style
-- classes .warning and .error may also be used with entries.
-- 
-- When the entry shows icons, it adds subnodes with the name image and the
-- style class .left or .right, depending on where the icon appears.
-- 
-- When the entry shows progress, it adds a subnode with the name progress.
-- The node has the style class .pulse when the shown progress is pulsing.
-- 
-- For all the subnodes added to the text node in various situations,
-- see t'GI.Gtk.Objects.Text.Text'.
-- 
-- = GtkEntry as GtkBuildable
-- 
-- The @GtkEntry@ implementation of the @GtkBuildable@ interface supports a
-- custom @\<attributes>@ element, which supports any number of @\<attribute>@
-- elements. The @\<attribute>@ element has attributes named “name“, “value“,
-- “start“ and “end“ and allows you to specify @PangoAttribute@ values for
-- this label.
-- 
-- An example of a UI definition fragment specifying Pango attributes:
-- 
-- === /xml code/
-- ><object class="GtkEntry">
-- >  <attributes>
-- >    <attribute name="weight" value="PANGO_WEIGHT_BOLD"/>
-- >    <attribute name="background" value="red" start="5" end="10"/>
-- >  </attributes>
-- ></object>
-- 
-- 
-- The start and end attributes specify the range of characters to which the
-- Pango attribute applies. If start and end are not specified, the attribute
-- is applied to the whole text. Note that specifying ranges does not make much
-- sense with translatable attributes. Use markup embedded in the translatable
-- content instead.
-- 
-- = Accessibility
-- 
-- @GtkEntry@ uses the 'GI.Gtk.Enums.AccessibleRoleTextBox' role.

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

module GI.Gtk.Objects.Entry
    ( 

-- * Exported types
    Entry(..)                               ,
    IsEntry                                 ,
    toEntry                                 ,


 -- * 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"), [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"), [editingDone]("GI.Gtk.Interfaces.CellEditable#g:method:editingDone"), [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.Entry#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"), [progressPulse]("GI.Gtk.Objects.Entry#g:method:progressPulse"), [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"), [removeWidget]("GI.Gtk.Interfaces.CellEditable#g:method:removeWidget"), [resetImContext]("GI.Gtk.Objects.Entry#g:method:resetImContext"), [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"), [startEditing]("GI.Gtk.Interfaces.CellEditable#g:method:startEditing"), [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.Entry#g:method:unsetInvisibleChar"), [unsetStateFlags]("GI.Gtk.Objects.Widget#g:method:unsetStateFlags"), [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"), [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.Entry#g:method:getActivatesDefault"), [getAlignment]("GI.Gtk.Objects.Entry#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.Entry#g:method:getAttributes"), [getBaseline]("GI.Gtk.Objects.Widget#g:method:getBaseline"), [getBounds]("GI.Gtk.Interfaces.Accessible#g:method:getBounds"), [getBuffer]("GI.Gtk.Objects.Entry#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"), [getCompletion]("GI.Gtk.Objects.Entry#g:method:getCompletion"), [getCssClasses]("GI.Gtk.Objects.Widget#g:method:getCssClasses"), [getCssName]("GI.Gtk.Objects.Widget#g:method:getCssName"), [getCurrentIconDragSource]("GI.Gtk.Objects.Entry#g:method:getCurrentIconDragSource"), [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"), [getEnableUndo]("GI.Gtk.Interfaces.Editable#g:method:getEnableUndo"), [getExtraMenu]("GI.Gtk.Objects.Entry#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"), [getHasFrame]("GI.Gtk.Objects.Entry#g:method:getHasFrame"), [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"), [getIconActivatable]("GI.Gtk.Objects.Entry#g:method:getIconActivatable"), [getIconArea]("GI.Gtk.Objects.Entry#g:method:getIconArea"), [getIconAtPos]("GI.Gtk.Objects.Entry#g:method:getIconAtPos"), [getIconGicon]("GI.Gtk.Objects.Entry#g:method:getIconGicon"), [getIconName]("GI.Gtk.Objects.Entry#g:method:getIconName"), [getIconPaintable]("GI.Gtk.Objects.Entry#g:method:getIconPaintable"), [getIconSensitive]("GI.Gtk.Objects.Entry#g:method:getIconSensitive"), [getIconStorageType]("GI.Gtk.Objects.Entry#g:method:getIconStorageType"), [getIconTooltipMarkup]("GI.Gtk.Objects.Entry#g:method:getIconTooltipMarkup"), [getIconTooltipText]("GI.Gtk.Objects.Entry#g:method:getIconTooltipText"), [getInputHints]("GI.Gtk.Objects.Entry#g:method:getInputHints"), [getInputPurpose]("GI.Gtk.Objects.Entry#g:method:getInputPurpose"), [getInvisibleChar]("GI.Gtk.Objects.Entry#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.Entry#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.Entry#g:method:getOverwriteMode"), [getPangoContext]("GI.Gtk.Objects.Widget#g:method:getPangoContext"), [getParent]("GI.Gtk.Objects.Widget#g:method:getParent"), [getPlaceholderText]("GI.Gtk.Objects.Entry#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"), [getProgressFraction]("GI.Gtk.Objects.Entry#g:method:getProgressFraction"), [getProgressPulseStep]("GI.Gtk.Objects.Entry#g:method:getProgressPulseStep"), [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.Entry#g:method:getTabs"), [getTemplateChild]("GI.Gtk.Objects.Widget#g:method:getTemplateChild"), [getText]("GI.Gtk.Interfaces.Editable#g:method:getText"), [getTextLength]("GI.Gtk.Objects.Entry#g:method:getTextLength"), [getTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:getTooltipMarkup"), [getTooltipText]("GI.Gtk.Objects.Widget#g:method:getTooltipText"), [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.Entry#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.Entry#g:method:setActivatesDefault"), [setAlignment]("GI.Gtk.Objects.Entry#g:method:setAlignment"), [setAttributes]("GI.Gtk.Objects.Entry#g:method:setAttributes"), [setBuffer]("GI.Gtk.Objects.Entry#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"), [setCompletion]("GI.Gtk.Objects.Entry#g:method:setCompletion"), [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"), [setEnableUndo]("GI.Gtk.Interfaces.Editable#g:method:setEnableUndo"), [setExtraMenu]("GI.Gtk.Objects.Entry#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"), [setHasFrame]("GI.Gtk.Objects.Entry#g:method:setHasFrame"), [setHasTooltip]("GI.Gtk.Objects.Widget#g:method:setHasTooltip"), [setHexpand]("GI.Gtk.Objects.Widget#g:method:setHexpand"), [setHexpandSet]("GI.Gtk.Objects.Widget#g:method:setHexpandSet"), [setIconActivatable]("GI.Gtk.Objects.Entry#g:method:setIconActivatable"), [setIconDragSource]("GI.Gtk.Objects.Entry#g:method:setIconDragSource"), [setIconFromGicon]("GI.Gtk.Objects.Entry#g:method:setIconFromGicon"), [setIconFromIconName]("GI.Gtk.Objects.Entry#g:method:setIconFromIconName"), [setIconFromPaintable]("GI.Gtk.Objects.Entry#g:method:setIconFromPaintable"), [setIconSensitive]("GI.Gtk.Objects.Entry#g:method:setIconSensitive"), [setIconTooltipMarkup]("GI.Gtk.Objects.Entry#g:method:setIconTooltipMarkup"), [setIconTooltipText]("GI.Gtk.Objects.Entry#g:method:setIconTooltipText"), [setInputHints]("GI.Gtk.Objects.Entry#g:method:setInputHints"), [setInputPurpose]("GI.Gtk.Objects.Entry#g:method:setInputPurpose"), [setInvisibleChar]("GI.Gtk.Objects.Entry#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.Entry#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.Entry#g:method:setOverwriteMode"), [setParent]("GI.Gtk.Objects.Widget#g:method:setParent"), [setPlaceholderText]("GI.Gtk.Objects.Entry#g:method:setPlaceholderText"), [setPosition]("GI.Gtk.Interfaces.Editable#g:method:setPosition"), [setProgressFraction]("GI.Gtk.Objects.Entry#g:method:setProgressFraction"), [setProgressPulseStep]("GI.Gtk.Objects.Entry#g:method:setProgressPulseStep"), [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.Entry#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"), [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.Entry#g:method:setVisibility"), [setVisible]("GI.Gtk.Objects.Widget#g:method:setVisible"), [setWidthChars]("GI.Gtk.Interfaces.Editable#g:method:setWidthChars").

#if defined(ENABLE_OVERLOADING)
    ResolveEntryMethod                      ,
#endif

-- ** getActivatesDefault #method:getActivatesDefault#

#if defined(ENABLE_OVERLOADING)
    EntryGetActivatesDefaultMethodInfo      ,
#endif
    entryGetActivatesDefault                ,


-- ** getAlignment #method:getAlignment#

#if defined(ENABLE_OVERLOADING)
    EntryGetAlignmentMethodInfo             ,
#endif
    entryGetAlignment                       ,


-- ** getAttributes #method:getAttributes#

#if defined(ENABLE_OVERLOADING)
    EntryGetAttributesMethodInfo            ,
#endif
    entryGetAttributes                      ,


-- ** getBuffer #method:getBuffer#

#if defined(ENABLE_OVERLOADING)
    EntryGetBufferMethodInfo                ,
#endif
    entryGetBuffer                          ,


-- ** getCompletion #method:getCompletion#

#if defined(ENABLE_OVERLOADING)
    EntryGetCompletionMethodInfo            ,
#endif
    entryGetCompletion                      ,


-- ** getCurrentIconDragSource #method:getCurrentIconDragSource#

#if defined(ENABLE_OVERLOADING)
    EntryGetCurrentIconDragSourceMethodInfo ,
#endif
    entryGetCurrentIconDragSource           ,


-- ** getExtraMenu #method:getExtraMenu#

#if defined(ENABLE_OVERLOADING)
    EntryGetExtraMenuMethodInfo             ,
#endif
    entryGetExtraMenu                       ,


-- ** getHasFrame #method:getHasFrame#

#if defined(ENABLE_OVERLOADING)
    EntryGetHasFrameMethodInfo              ,
#endif
    entryGetHasFrame                        ,


-- ** getIconActivatable #method:getIconActivatable#

#if defined(ENABLE_OVERLOADING)
    EntryGetIconActivatableMethodInfo       ,
#endif
    entryGetIconActivatable                 ,


-- ** getIconArea #method:getIconArea#

#if defined(ENABLE_OVERLOADING)
    EntryGetIconAreaMethodInfo              ,
#endif
    entryGetIconArea                        ,


-- ** getIconAtPos #method:getIconAtPos#

#if defined(ENABLE_OVERLOADING)
    EntryGetIconAtPosMethodInfo             ,
#endif
    entryGetIconAtPos                       ,


-- ** getIconGicon #method:getIconGicon#

#if defined(ENABLE_OVERLOADING)
    EntryGetIconGiconMethodInfo             ,
#endif
    entryGetIconGicon                       ,


-- ** getIconName #method:getIconName#

#if defined(ENABLE_OVERLOADING)
    EntryGetIconNameMethodInfo              ,
#endif
    entryGetIconName                        ,


-- ** getIconPaintable #method:getIconPaintable#

#if defined(ENABLE_OVERLOADING)
    EntryGetIconPaintableMethodInfo         ,
#endif
    entryGetIconPaintable                   ,


-- ** getIconSensitive #method:getIconSensitive#

#if defined(ENABLE_OVERLOADING)
    EntryGetIconSensitiveMethodInfo         ,
#endif
    entryGetIconSensitive                   ,


-- ** getIconStorageType #method:getIconStorageType#

#if defined(ENABLE_OVERLOADING)
    EntryGetIconStorageTypeMethodInfo       ,
#endif
    entryGetIconStorageType                 ,


-- ** getIconTooltipMarkup #method:getIconTooltipMarkup#

#if defined(ENABLE_OVERLOADING)
    EntryGetIconTooltipMarkupMethodInfo     ,
#endif
    entryGetIconTooltipMarkup               ,


-- ** getIconTooltipText #method:getIconTooltipText#

#if defined(ENABLE_OVERLOADING)
    EntryGetIconTooltipTextMethodInfo       ,
#endif
    entryGetIconTooltipText                 ,


-- ** getInputHints #method:getInputHints#

#if defined(ENABLE_OVERLOADING)
    EntryGetInputHintsMethodInfo            ,
#endif
    entryGetInputHints                      ,


-- ** getInputPurpose #method:getInputPurpose#

#if defined(ENABLE_OVERLOADING)
    EntryGetInputPurposeMethodInfo          ,
#endif
    entryGetInputPurpose                    ,


-- ** getInvisibleChar #method:getInvisibleChar#

#if defined(ENABLE_OVERLOADING)
    EntryGetInvisibleCharMethodInfo         ,
#endif
    entryGetInvisibleChar                   ,


-- ** getMaxLength #method:getMaxLength#

#if defined(ENABLE_OVERLOADING)
    EntryGetMaxLengthMethodInfo             ,
#endif
    entryGetMaxLength                       ,


-- ** getOverwriteMode #method:getOverwriteMode#

#if defined(ENABLE_OVERLOADING)
    EntryGetOverwriteModeMethodInfo         ,
#endif
    entryGetOverwriteMode                   ,


-- ** getPlaceholderText #method:getPlaceholderText#

#if defined(ENABLE_OVERLOADING)
    EntryGetPlaceholderTextMethodInfo       ,
#endif
    entryGetPlaceholderText                 ,


-- ** getProgressFraction #method:getProgressFraction#

#if defined(ENABLE_OVERLOADING)
    EntryGetProgressFractionMethodInfo      ,
#endif
    entryGetProgressFraction                ,


-- ** getProgressPulseStep #method:getProgressPulseStep#

#if defined(ENABLE_OVERLOADING)
    EntryGetProgressPulseStepMethodInfo     ,
#endif
    entryGetProgressPulseStep               ,


-- ** getTabs #method:getTabs#

#if defined(ENABLE_OVERLOADING)
    EntryGetTabsMethodInfo                  ,
#endif
    entryGetTabs                            ,


-- ** getTextLength #method:getTextLength#

#if defined(ENABLE_OVERLOADING)
    EntryGetTextLengthMethodInfo            ,
#endif
    entryGetTextLength                      ,


-- ** getVisibility #method:getVisibility#

#if defined(ENABLE_OVERLOADING)
    EntryGetVisibilityMethodInfo            ,
#endif
    entryGetVisibility                      ,


-- ** grabFocusWithoutSelecting #method:grabFocusWithoutSelecting#

#if defined(ENABLE_OVERLOADING)
    EntryGrabFocusWithoutSelectingMethodInfo,
#endif
    entryGrabFocusWithoutSelecting          ,


-- ** new #method:new#

    entryNew                                ,


-- ** newWithBuffer #method:newWithBuffer#

    entryNewWithBuffer                      ,


-- ** progressPulse #method:progressPulse#

#if defined(ENABLE_OVERLOADING)
    EntryProgressPulseMethodInfo            ,
#endif
    entryProgressPulse                      ,


-- ** resetImContext #method:resetImContext#

#if defined(ENABLE_OVERLOADING)
    EntryResetImContextMethodInfo           ,
#endif
    entryResetImContext                     ,


-- ** setActivatesDefault #method:setActivatesDefault#

#if defined(ENABLE_OVERLOADING)
    EntrySetActivatesDefaultMethodInfo      ,
#endif
    entrySetActivatesDefault                ,


-- ** setAlignment #method:setAlignment#

#if defined(ENABLE_OVERLOADING)
    EntrySetAlignmentMethodInfo             ,
#endif
    entrySetAlignment                       ,


-- ** setAttributes #method:setAttributes#

#if defined(ENABLE_OVERLOADING)
    EntrySetAttributesMethodInfo            ,
#endif
    entrySetAttributes                      ,


-- ** setBuffer #method:setBuffer#

#if defined(ENABLE_OVERLOADING)
    EntrySetBufferMethodInfo                ,
#endif
    entrySetBuffer                          ,


-- ** setCompletion #method:setCompletion#

#if defined(ENABLE_OVERLOADING)
    EntrySetCompletionMethodInfo            ,
#endif
    entrySetCompletion                      ,


-- ** setExtraMenu #method:setExtraMenu#

#if defined(ENABLE_OVERLOADING)
    EntrySetExtraMenuMethodInfo             ,
#endif
    entrySetExtraMenu                       ,


-- ** setHasFrame #method:setHasFrame#

#if defined(ENABLE_OVERLOADING)
    EntrySetHasFrameMethodInfo              ,
#endif
    entrySetHasFrame                        ,


-- ** setIconActivatable #method:setIconActivatable#

#if defined(ENABLE_OVERLOADING)
    EntrySetIconActivatableMethodInfo       ,
#endif
    entrySetIconActivatable                 ,


-- ** setIconDragSource #method:setIconDragSource#

#if defined(ENABLE_OVERLOADING)
    EntrySetIconDragSourceMethodInfo        ,
#endif
    entrySetIconDragSource                  ,


-- ** setIconFromGicon #method:setIconFromGicon#

#if defined(ENABLE_OVERLOADING)
    EntrySetIconFromGiconMethodInfo         ,
#endif
    entrySetIconFromGicon                   ,


-- ** setIconFromIconName #method:setIconFromIconName#

#if defined(ENABLE_OVERLOADING)
    EntrySetIconFromIconNameMethodInfo      ,
#endif
    entrySetIconFromIconName                ,


-- ** setIconFromPaintable #method:setIconFromPaintable#

#if defined(ENABLE_OVERLOADING)
    EntrySetIconFromPaintableMethodInfo     ,
#endif
    entrySetIconFromPaintable               ,


-- ** setIconSensitive #method:setIconSensitive#

#if defined(ENABLE_OVERLOADING)
    EntrySetIconSensitiveMethodInfo         ,
#endif
    entrySetIconSensitive                   ,


-- ** setIconTooltipMarkup #method:setIconTooltipMarkup#

#if defined(ENABLE_OVERLOADING)
    EntrySetIconTooltipMarkupMethodInfo     ,
#endif
    entrySetIconTooltipMarkup               ,


-- ** setIconTooltipText #method:setIconTooltipText#

#if defined(ENABLE_OVERLOADING)
    EntrySetIconTooltipTextMethodInfo       ,
#endif
    entrySetIconTooltipText                 ,


-- ** setInputHints #method:setInputHints#

#if defined(ENABLE_OVERLOADING)
    EntrySetInputHintsMethodInfo            ,
#endif
    entrySetInputHints                      ,


-- ** setInputPurpose #method:setInputPurpose#

#if defined(ENABLE_OVERLOADING)
    EntrySetInputPurposeMethodInfo          ,
#endif
    entrySetInputPurpose                    ,


-- ** setInvisibleChar #method:setInvisibleChar#

#if defined(ENABLE_OVERLOADING)
    EntrySetInvisibleCharMethodInfo         ,
#endif
    entrySetInvisibleChar                   ,


-- ** setMaxLength #method:setMaxLength#

#if defined(ENABLE_OVERLOADING)
    EntrySetMaxLengthMethodInfo             ,
#endif
    entrySetMaxLength                       ,


-- ** setOverwriteMode #method:setOverwriteMode#

#if defined(ENABLE_OVERLOADING)
    EntrySetOverwriteModeMethodInfo         ,
#endif
    entrySetOverwriteMode                   ,


-- ** setPlaceholderText #method:setPlaceholderText#

#if defined(ENABLE_OVERLOADING)
    EntrySetPlaceholderTextMethodInfo       ,
#endif
    entrySetPlaceholderText                 ,


-- ** setProgressFraction #method:setProgressFraction#

#if defined(ENABLE_OVERLOADING)
    EntrySetProgressFractionMethodInfo      ,
#endif
    entrySetProgressFraction                ,


-- ** setProgressPulseStep #method:setProgressPulseStep#

#if defined(ENABLE_OVERLOADING)
    EntrySetProgressPulseStepMethodInfo     ,
#endif
    entrySetProgressPulseStep               ,


-- ** setTabs #method:setTabs#

#if defined(ENABLE_OVERLOADING)
    EntrySetTabsMethodInfo                  ,
#endif
    entrySetTabs                            ,


-- ** setVisibility #method:setVisibility#

#if defined(ENABLE_OVERLOADING)
    EntrySetVisibilityMethodInfo            ,
#endif
    entrySetVisibility                      ,


-- ** unsetInvisibleChar #method:unsetInvisibleChar#

#if defined(ENABLE_OVERLOADING)
    EntryUnsetInvisibleCharMethodInfo       ,
#endif
    entryUnsetInvisibleChar                 ,




 -- * Properties


-- ** activatesDefault #attr:activatesDefault#
-- | Whether to activate the default widget when Enter is pressed.

#if defined(ENABLE_OVERLOADING)
    EntryActivatesDefaultPropertyInfo       ,
#endif
    constructEntryActivatesDefault          ,
#if defined(ENABLE_OVERLOADING)
    entryActivatesDefault                   ,
#endif
    getEntryActivatesDefault                ,
    setEntryActivatesDefault                ,


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

#if defined(ENABLE_OVERLOADING)
    EntryAttributesPropertyInfo             ,
#endif
    constructEntryAttributes                ,
#if defined(ENABLE_OVERLOADING)
    entryAttributes                         ,
#endif
    getEntryAttributes                      ,
    setEntryAttributes                      ,


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

#if defined(ENABLE_OVERLOADING)
    EntryBufferPropertyInfo                 ,
#endif
    constructEntryBuffer                    ,
#if defined(ENABLE_OVERLOADING)
    entryBuffer                             ,
#endif
    getEntryBuffer                          ,
    setEntryBuffer                          ,


-- ** completion #attr:completion#
-- | The auxiliary completion object to use with the entry.

#if defined(ENABLE_OVERLOADING)
    EntryCompletionPropertyInfo             ,
#endif
    clearEntryCompletion                    ,
    constructEntryCompletion                ,
#if defined(ENABLE_OVERLOADING)
    entryCompletion                         ,
#endif
    getEntryCompletion                      ,
    setEntryCompletion                      ,


-- ** enableEmojiCompletion #attr:enableEmojiCompletion#
-- | Whether to suggest Emoji replacements for :-delimited names
-- like @:heart:@.

#if defined(ENABLE_OVERLOADING)
    EntryEnableEmojiCompletionPropertyInfo  ,
#endif
    constructEntryEnableEmojiCompletion     ,
#if defined(ENABLE_OVERLOADING)
    entryEnableEmojiCompletion              ,
#endif
    getEntryEnableEmojiCompletion           ,
    setEntryEnableEmojiCompletion           ,


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

#if defined(ENABLE_OVERLOADING)
    EntryExtraMenuPropertyInfo              ,
#endif
    clearEntryExtraMenu                     ,
    constructEntryExtraMenu                 ,
#if defined(ENABLE_OVERLOADING)
    entryExtraMenu                          ,
#endif
    getEntryExtraMenu                       ,
    setEntryExtraMenu                       ,


-- ** hasFrame #attr:hasFrame#
-- | Whether the entry should draw a frame.

#if defined(ENABLE_OVERLOADING)
    EntryHasFramePropertyInfo               ,
#endif
    constructEntryHasFrame                  ,
#if defined(ENABLE_OVERLOADING)
    entryHasFrame                           ,
#endif
    getEntryHasFrame                        ,
    setEntryHasFrame                        ,


-- ** imModule #attr:imModule#
-- | Which IM (input method) module should be used for this entry.
-- 
-- See t'GI.Gtk.Objects.IMContext.IMContext'.
-- 
-- Setting this to a non-'P.Nothing' value overrides the system-wide IM
-- module setting. See the GtkSettings [Settings:gtkImModule]("GI.Gtk.Objects.Settings#g:attr:gtkImModule")
-- property.

#if defined(ENABLE_OVERLOADING)
    EntryImModulePropertyInfo               ,
#endif
    clearEntryImModule                      ,
    constructEntryImModule                  ,
#if defined(ENABLE_OVERLOADING)
    entryImModule                           ,
#endif
    getEntryImModule                        ,
    setEntryImModule                        ,


-- ** inputHints #attr:inputHints#
-- | Additional hints that allow input methods to fine-tune their behavior.
-- 
-- Also see [Entry:inputPurpose]("GI.Gtk.Objects.Entry#g:attr:inputPurpose")

#if defined(ENABLE_OVERLOADING)
    EntryInputHintsPropertyInfo             ,
#endif
    constructEntryInputHints                ,
#if defined(ENABLE_OVERLOADING)
    entryInputHints                         ,
#endif
    getEntryInputHints                      ,
    setEntryInputHints                      ,


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

#if defined(ENABLE_OVERLOADING)
    EntryInputPurposePropertyInfo           ,
#endif
    constructEntryInputPurpose              ,
#if defined(ENABLE_OVERLOADING)
    entryInputPurpose                       ,
#endif
    getEntryInputPurpose                    ,
    setEntryInputPurpose                    ,


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

#if defined(ENABLE_OVERLOADING)
    EntryInvisibleCharPropertyInfo          ,
#endif
    constructEntryInvisibleChar             ,
#if defined(ENABLE_OVERLOADING)
    entryInvisibleChar                      ,
#endif
    getEntryInvisibleChar                   ,
    setEntryInvisibleChar                   ,


-- ** invisibleCharSet #attr:invisibleCharSet#
-- | Whether the invisible char has been set for the @GtkEntry@.

#if defined(ENABLE_OVERLOADING)
    EntryInvisibleCharSetPropertyInfo       ,
#endif
    constructEntryInvisibleCharSet          ,
#if defined(ENABLE_OVERLOADING)
    entryInvisibleCharSet                   ,
#endif
    getEntryInvisibleCharSet                ,
    setEntryInvisibleCharSet                ,


-- ** maxLength #attr:maxLength#
-- | Maximum number of characters for this entry.

#if defined(ENABLE_OVERLOADING)
    EntryMaxLengthPropertyInfo              ,
#endif
    constructEntryMaxLength                 ,
#if defined(ENABLE_OVERLOADING)
    entryMaxLength                          ,
#endif
    getEntryMaxLength                       ,
    setEntryMaxLength                       ,


-- ** overwriteMode #attr:overwriteMode#
-- | If text is overwritten when typing in the @GtkEntry@.

#if defined(ENABLE_OVERLOADING)
    EntryOverwriteModePropertyInfo          ,
#endif
    constructEntryOverwriteMode             ,
#if defined(ENABLE_OVERLOADING)
    entryOverwriteMode                      ,
#endif
    getEntryOverwriteMode                   ,
    setEntryOverwriteMode                   ,


-- ** placeholderText #attr:placeholderText#
-- | The text that will be displayed in the @GtkEntry@ when it is empty
-- and unfocused.

#if defined(ENABLE_OVERLOADING)
    EntryPlaceholderTextPropertyInfo        ,
#endif
    clearEntryPlaceholderText               ,
    constructEntryPlaceholderText           ,
#if defined(ENABLE_OVERLOADING)
    entryPlaceholderText                    ,
#endif
    getEntryPlaceholderText                 ,
    setEntryPlaceholderText                 ,


-- ** primaryIconActivatable #attr:primaryIconActivatable#
-- | Whether the primary icon is activatable.
-- 
-- GTK emits the [Entry::iconPress]("GI.Gtk.Objects.Entry#g:signal:iconPress") and
-- [Entry::iconRelease]("GI.Gtk.Objects.Entry#g:signal:iconRelease") signals only on sensitive,
-- activatable icons.
-- 
-- Sensitive, but non-activatable icons can be used for purely
-- informational purposes.

#if defined(ENABLE_OVERLOADING)
    EntryPrimaryIconActivatablePropertyInfo ,
#endif
    constructEntryPrimaryIconActivatable    ,
#if defined(ENABLE_OVERLOADING)
    entryPrimaryIconActivatable             ,
#endif
    getEntryPrimaryIconActivatable          ,
    setEntryPrimaryIconActivatable          ,


-- ** primaryIconGicon #attr:primaryIconGicon#
-- | The @GIcon@ to use for the primary icon for the entry.

#if defined(ENABLE_OVERLOADING)
    EntryPrimaryIconGiconPropertyInfo       ,
#endif
    clearEntryPrimaryIconGicon              ,
    constructEntryPrimaryIconGicon          ,
#if defined(ENABLE_OVERLOADING)
    entryPrimaryIconGicon                   ,
#endif
    getEntryPrimaryIconGicon                ,
    setEntryPrimaryIconGicon                ,


-- ** primaryIconName #attr:primaryIconName#
-- | The icon name to use for the primary icon for the entry.

#if defined(ENABLE_OVERLOADING)
    EntryPrimaryIconNamePropertyInfo        ,
#endif
    clearEntryPrimaryIconName               ,
    constructEntryPrimaryIconName           ,
#if defined(ENABLE_OVERLOADING)
    entryPrimaryIconName                    ,
#endif
    getEntryPrimaryIconName                 ,
    setEntryPrimaryIconName                 ,


-- ** primaryIconPaintable #attr:primaryIconPaintable#
-- | A @GdkPaintable@ to use as the primary icon for the entry.

#if defined(ENABLE_OVERLOADING)
    EntryPrimaryIconPaintablePropertyInfo   ,
#endif
    clearEntryPrimaryIconPaintable          ,
    constructEntryPrimaryIconPaintable      ,
#if defined(ENABLE_OVERLOADING)
    entryPrimaryIconPaintable               ,
#endif
    getEntryPrimaryIconPaintable            ,
    setEntryPrimaryIconPaintable            ,


-- ** primaryIconSensitive #attr:primaryIconSensitive#
-- | Whether the primary icon is sensitive.
-- 
-- An insensitive icon appears grayed out. GTK does not emit the
-- [Entry::iconPress]("GI.Gtk.Objects.Entry#g:signal:iconPress") and [Entry::iconRelease]("GI.Gtk.Objects.Entry#g:signal:iconRelease")
-- signals and does not allow DND from insensitive icons.
-- 
-- An icon should be set insensitive if the action that would trigger
-- when clicked is currently not available.

#if defined(ENABLE_OVERLOADING)
    EntryPrimaryIconSensitivePropertyInfo   ,
#endif
    constructEntryPrimaryIconSensitive      ,
#if defined(ENABLE_OVERLOADING)
    entryPrimaryIconSensitive               ,
#endif
    getEntryPrimaryIconSensitive            ,
    setEntryPrimaryIconSensitive            ,


-- ** primaryIconStorageType #attr:primaryIconStorageType#
-- | The representation which is used for the primary icon of the entry.

#if defined(ENABLE_OVERLOADING)
    EntryPrimaryIconStorageTypePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
    entryPrimaryIconStorageType             ,
#endif
    getEntryPrimaryIconStorageType          ,


-- ** primaryIconTooltipMarkup #attr:primaryIconTooltipMarkup#
-- | The contents of the tooltip on the primary icon, with markup.
-- 
-- Also see 'GI.Gtk.Objects.Entry.entrySetIconTooltipMarkup'.

#if defined(ENABLE_OVERLOADING)
    EntryPrimaryIconTooltipMarkupPropertyInfo,
#endif
    clearEntryPrimaryIconTooltipMarkup      ,
    constructEntryPrimaryIconTooltipMarkup  ,
#if defined(ENABLE_OVERLOADING)
    entryPrimaryIconTooltipMarkup           ,
#endif
    getEntryPrimaryIconTooltipMarkup        ,
    setEntryPrimaryIconTooltipMarkup        ,


-- ** primaryIconTooltipText #attr:primaryIconTooltipText#
-- | The contents of the tooltip on the primary icon.
-- 
-- Also see 'GI.Gtk.Objects.Entry.entrySetIconTooltipText'.

#if defined(ENABLE_OVERLOADING)
    EntryPrimaryIconTooltipTextPropertyInfo ,
#endif
    clearEntryPrimaryIconTooltipText        ,
    constructEntryPrimaryIconTooltipText    ,
#if defined(ENABLE_OVERLOADING)
    entryPrimaryIconTooltipText             ,
#endif
    getEntryPrimaryIconTooltipText          ,
    setEntryPrimaryIconTooltipText          ,


-- ** progressFraction #attr:progressFraction#
-- | The current fraction of the task that\'s been completed.

#if defined(ENABLE_OVERLOADING)
    EntryProgressFractionPropertyInfo       ,
#endif
    constructEntryProgressFraction          ,
#if defined(ENABLE_OVERLOADING)
    entryProgressFraction                   ,
#endif
    getEntryProgressFraction                ,
    setEntryProgressFraction                ,


-- ** progressPulseStep #attr:progressPulseStep#
-- | The fraction of total entry width to move the progress
-- bouncing block for each pulse.
-- 
-- See 'GI.Gtk.Objects.Entry.entryProgressPulse'.

#if defined(ENABLE_OVERLOADING)
    EntryProgressPulseStepPropertyInfo      ,
#endif
    constructEntryProgressPulseStep         ,
#if defined(ENABLE_OVERLOADING)
    entryProgressPulseStep                  ,
#endif
    getEntryProgressPulseStep               ,
    setEntryProgressPulseStep               ,


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

#if defined(ENABLE_OVERLOADING)
    EntryScrollOffsetPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    entryScrollOffset                       ,
#endif
    getEntryScrollOffset                    ,


-- ** secondaryIconActivatable #attr:secondaryIconActivatable#
-- | Whether the secondary icon is activatable.
-- 
-- GTK emits the [Entry::iconPress]("GI.Gtk.Objects.Entry#g:signal:iconPress") and
-- [Entry::iconRelease]("GI.Gtk.Objects.Entry#g:signal:iconRelease") signals only on sensitive,
-- activatable icons.
-- 
-- Sensitive, but non-activatable icons can be used for purely
-- informational purposes.

#if defined(ENABLE_OVERLOADING)
    EntrySecondaryIconActivatablePropertyInfo,
#endif
    constructEntrySecondaryIconActivatable  ,
#if defined(ENABLE_OVERLOADING)
    entrySecondaryIconActivatable           ,
#endif
    getEntrySecondaryIconActivatable        ,
    setEntrySecondaryIconActivatable        ,


-- ** secondaryIconGicon #attr:secondaryIconGicon#
-- | The @GIcon@ to use for the secondary icon for the entry.

#if defined(ENABLE_OVERLOADING)
    EntrySecondaryIconGiconPropertyInfo     ,
#endif
    clearEntrySecondaryIconGicon            ,
    constructEntrySecondaryIconGicon        ,
#if defined(ENABLE_OVERLOADING)
    entrySecondaryIconGicon                 ,
#endif
    getEntrySecondaryIconGicon              ,
    setEntrySecondaryIconGicon              ,


-- ** secondaryIconName #attr:secondaryIconName#
-- | The icon name to use for the secondary icon for the entry.

#if defined(ENABLE_OVERLOADING)
    EntrySecondaryIconNamePropertyInfo      ,
#endif
    clearEntrySecondaryIconName             ,
    constructEntrySecondaryIconName         ,
#if defined(ENABLE_OVERLOADING)
    entrySecondaryIconName                  ,
#endif
    getEntrySecondaryIconName               ,
    setEntrySecondaryIconName               ,


-- ** secondaryIconPaintable #attr:secondaryIconPaintable#
-- | A @GdkPaintable@ to use as the secondary icon for the entry.

#if defined(ENABLE_OVERLOADING)
    EntrySecondaryIconPaintablePropertyInfo ,
#endif
    clearEntrySecondaryIconPaintable        ,
    constructEntrySecondaryIconPaintable    ,
#if defined(ENABLE_OVERLOADING)
    entrySecondaryIconPaintable             ,
#endif
    getEntrySecondaryIconPaintable          ,
    setEntrySecondaryIconPaintable          ,


-- ** secondaryIconSensitive #attr:secondaryIconSensitive#
-- | Whether the secondary icon is sensitive.
-- 
-- An insensitive icon appears grayed out. GTK does not emit the
-- [signal/@gtk@/.Entry[iconPress](#g:signal:iconPress)[ and [Entry::iconRelease]("GI.Gtk.Objects.Entry#g:signal:iconRelease")
-- signals and does not allow DND from insensitive icons.
-- 
-- An icon should be set insensitive if the action that would trigger
-- when clicked is currently not available.

#if defined(ENABLE_OVERLOADING)
    EntrySecondaryIconSensitivePropertyInfo ,
#endif
    constructEntrySecondaryIconSensitive    ,
#if defined(ENABLE_OVERLOADING)
    entrySecondaryIconSensitive             ,
#endif
    getEntrySecondaryIconSensitive          ,
    setEntrySecondaryIconSensitive          ,


-- ** secondaryIconStorageType #attr:secondaryIconStorageType#
-- | The representation which is used for the secondary icon of the entry.

#if defined(ENABLE_OVERLOADING)
    EntrySecondaryIconStorageTypePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    entrySecondaryIconStorageType           ,
#endif
    getEntrySecondaryIconStorageType        ,


-- ** secondaryIconTooltipMarkup #attr:secondaryIconTooltipMarkup#
-- | The contents of the tooltip on the secondary icon, with markup.
-- 
-- Also see 'GI.Gtk.Objects.Entry.entrySetIconTooltipMarkup'.

#if defined(ENABLE_OVERLOADING)
    EntrySecondaryIconTooltipMarkupPropertyInfo,
#endif
    clearEntrySecondaryIconTooltipMarkup    ,
    constructEntrySecondaryIconTooltipMarkup,
#if defined(ENABLE_OVERLOADING)
    entrySecondaryIconTooltipMarkup         ,
#endif
    getEntrySecondaryIconTooltipMarkup      ,
    setEntrySecondaryIconTooltipMarkup      ,


-- ** secondaryIconTooltipText #attr:secondaryIconTooltipText#
-- | The contents of the tooltip on the secondary icon.
-- 
-- Also see 'GI.Gtk.Objects.Entry.entrySetIconTooltipText'.

#if defined(ENABLE_OVERLOADING)
    EntrySecondaryIconTooltipTextPropertyInfo,
#endif
    clearEntrySecondaryIconTooltipText      ,
    constructEntrySecondaryIconTooltipText  ,
#if defined(ENABLE_OVERLOADING)
    entrySecondaryIconTooltipText           ,
#endif
    getEntrySecondaryIconTooltipText        ,
    setEntrySecondaryIconTooltipText        ,


-- ** showEmojiIcon #attr:showEmojiIcon#
-- | Whether the entry will show an Emoji icon in the secondary icon position
-- to open the Emoji chooser.

#if defined(ENABLE_OVERLOADING)
    EntryShowEmojiIconPropertyInfo          ,
#endif
    constructEntryShowEmojiIcon             ,
#if defined(ENABLE_OVERLOADING)
    entryShowEmojiIcon                      ,
#endif
    getEntryShowEmojiIcon                   ,
    setEntryShowEmojiIcon                   ,


-- ** tabs #attr:tabs#
-- | A list of tabstops to apply to the text of the entry.

#if defined(ENABLE_OVERLOADING)
    EntryTabsPropertyInfo                   ,
#endif
    clearEntryTabs                          ,
    constructEntryTabs                      ,
#if defined(ENABLE_OVERLOADING)
    entryTabs                               ,
#endif
    getEntryTabs                            ,
    setEntryTabs                            ,


-- ** textLength #attr:textLength#
-- | The length of the text in the @GtkEntry@.

#if defined(ENABLE_OVERLOADING)
    EntryTextLengthPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    entryTextLength                         ,
#endif
    getEntryTextLength                      ,


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

#if defined(ENABLE_OVERLOADING)
    EntryTruncateMultilinePropertyInfo      ,
#endif
    constructEntryTruncateMultiline         ,
#if defined(ENABLE_OVERLOADING)
    entryTruncateMultiline                  ,
#endif
    getEntryTruncateMultiline               ,
    setEntryTruncateMultiline               ,


-- ** visibility #attr:visibility#
-- | Whether the entry should show the “invisible char” instead of the
-- actual text (“password mode”).

#if defined(ENABLE_OVERLOADING)
    EntryVisibilityPropertyInfo             ,
#endif
    constructEntryVisibility                ,
#if defined(ENABLE_OVERLOADING)
    entryVisibility                         ,
#endif
    getEntryVisibility                      ,
    setEntryVisibility                      ,




 -- * Signals


-- ** activate #signal:activate#

    EntryActivateCallback                   ,
#if defined(ENABLE_OVERLOADING)
    EntryActivateSignalInfo                 ,
#endif
    afterEntryActivate                      ,
    onEntryActivate                         ,


-- ** iconPress #signal:iconPress#

    EntryIconPressCallback                  ,
#if defined(ENABLE_OVERLOADING)
    EntryIconPressSignalInfo                ,
#endif
    afterEntryIconPress                     ,
    onEntryIconPress                        ,


-- ** iconRelease #signal:iconRelease#

    EntryIconReleaseCallback                ,
#if defined(ENABLE_OVERLOADING)
    EntryIconReleaseSignalInfo              ,
#endif
    afterEntryIconRelease                   ,
    onEntryIconRelease                      ,




    ) 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.ContentProvider as Gdk.ContentProvider
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.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.CellEditable as Gtk.CellEditable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.CellLayout as Gtk.CellLayout
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.Interfaces.TreeModel as Gtk.TreeModel
import {-# SOURCE #-} qualified GI.Gtk.Objects.ATContext as Gtk.ATContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.CellArea as Gtk.CellArea
import {-# SOURCE #-} qualified GI.Gtk.Objects.CellAreaContext as Gtk.CellAreaContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.CellRenderer as Gtk.CellRenderer
import {-# SOURCE #-} qualified GI.Gtk.Objects.EntryBuffer as Gtk.EntryBuffer
import {-# SOURCE #-} qualified GI.Gtk.Objects.EntryCompletion as Gtk.EntryCompletion
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 {-# SOURCE #-} qualified GI.Gtk.Structs.TreeIter as Gtk.TreeIter
import {-# SOURCE #-} qualified GI.Gtk.Structs.TreePath as Gtk.TreePath
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.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.ContentProvider as Gdk.ContentProvider
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
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.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.CellEditable as Gtk.CellEditable
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.EntryCompletion as Gtk.EntryCompletion
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 Entry = Entry (SP.ManagedPtr Entry)
    deriving (Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
/= :: Entry -> Entry -> Bool
Eq)

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

foreign import ccall "gtk_entry_get_type"
    c_gtk_entry_get_type :: IO B.Types.GType

instance B.Types.TypedObject Entry where
    glibType :: IO GType
glibType = IO GType
c_gtk_entry_get_type

instance B.Types.GObject Entry

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

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

-- | Cast to t'Entry', for types for which this is known to be safe. For general casts, use 'Data.GI.Base.ManagedPtr.castTo'.
toEntry :: (MIO.MonadIO m, IsEntry o) => o -> m Entry
toEntry :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Entry
toEntry = IO Entry -> m Entry
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Entry -> m Entry) -> (o -> IO Entry) -> o -> m Entry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Entry -> Entry) -> o -> IO Entry
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Entry -> Entry
Entry

-- | Convert t'Entry' 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 Entry) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_entry_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Entry -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Entry
P.Nothing = Ptr GValue -> Ptr Entry -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Entry
forall a. Ptr a
FP.nullPtr :: FP.Ptr Entry)
    gvalueSet_ Ptr GValue
gv (P.Just Entry
obj) = Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Entry
obj (Ptr GValue -> Ptr Entry -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Entry)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr Entry)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Entry)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newObject Entry ptr
        else return P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveEntryMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveEntryMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveEntryMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveEntryMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveEntryMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveEntryMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveEntryMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveEntryMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveEntryMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveEntryMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveEntryMethod "announce" o = Gtk.Accessible.AccessibleAnnounceMethodInfo
    ResolveEntryMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveEntryMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveEntryMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveEntryMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveEntryMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveEntryMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveEntryMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveEntryMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveEntryMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveEntryMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveEntryMethod "delegateGetAccessiblePlatformState" o = Gtk.Editable.EditableDelegateGetAccessiblePlatformStateMethodInfo
    ResolveEntryMethod "deleteSelection" o = Gtk.Editable.EditableDeleteSelectionMethodInfo
    ResolveEntryMethod "deleteText" o = Gtk.Editable.EditableDeleteTextMethodInfo
    ResolveEntryMethod "disposeTemplate" o = Gtk.Widget.WidgetDisposeTemplateMethodInfo
    ResolveEntryMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveEntryMethod "editingDone" o = Gtk.CellEditable.CellEditableEditingDoneMethodInfo
    ResolveEntryMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveEntryMethod "finishDelegate" o = Gtk.Editable.EditableFinishDelegateMethodInfo
    ResolveEntryMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveEntryMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveEntryMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveEntryMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveEntryMethod "grabFocusWithoutSelecting" o = EntryGrabFocusWithoutSelectingMethodInfo
    ResolveEntryMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveEntryMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveEntryMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveEntryMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveEntryMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveEntryMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveEntryMethod "initDelegate" o = Gtk.Editable.EditableInitDelegateMethodInfo
    ResolveEntryMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveEntryMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveEntryMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveEntryMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveEntryMethod "insertText" o = Gtk.Editable.EditableInsertTextMethodInfo
    ResolveEntryMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveEntryMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveEntryMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveEntryMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveEntryMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveEntryMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveEntryMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveEntryMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveEntryMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveEntryMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveEntryMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveEntryMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveEntryMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveEntryMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveEntryMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveEntryMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveEntryMethod "progressPulse" o = EntryProgressPulseMethodInfo
    ResolveEntryMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveEntryMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveEntryMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveEntryMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveEntryMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveEntryMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveEntryMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveEntryMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveEntryMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveEntryMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveEntryMethod "removeWidget" o = Gtk.CellEditable.CellEditableRemoveWidgetMethodInfo
    ResolveEntryMethod "resetImContext" o = EntryResetImContextMethodInfo
    ResolveEntryMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
    ResolveEntryMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
    ResolveEntryMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
    ResolveEntryMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveEntryMethod "selectRegion" o = Gtk.Editable.EditableSelectRegionMethodInfo
    ResolveEntryMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolveEntryMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveEntryMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveEntryMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveEntryMethod "startEditing" o = Gtk.CellEditable.CellEditableStartEditingMethodInfo
    ResolveEntryMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveEntryMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveEntryMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveEntryMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveEntryMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveEntryMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveEntryMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveEntryMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveEntryMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveEntryMethod "unsetInvisibleChar" o = EntryUnsetInvisibleCharMethodInfo
    ResolveEntryMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveEntryMethod "updateNextAccessibleSibling" o = Gtk.Accessible.AccessibleUpdateNextAccessibleSiblingMethodInfo
    ResolveEntryMethod "updatePlatformState" o = Gtk.Accessible.AccessibleUpdatePlatformStateMethodInfo
    ResolveEntryMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
    ResolveEntryMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
    ResolveEntryMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
    ResolveEntryMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveEntryMethod "getAccessibleParent" o = Gtk.Accessible.AccessibleGetAccessibleParentMethodInfo
    ResolveEntryMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
    ResolveEntryMethod "getActivatesDefault" o = EntryGetActivatesDefaultMethodInfo
    ResolveEntryMethod "getAlignment" o = EntryGetAlignmentMethodInfo
    ResolveEntryMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveEntryMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveEntryMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveEntryMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveEntryMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveEntryMethod "getAtContext" o = Gtk.Accessible.AccessibleGetAtContextMethodInfo
    ResolveEntryMethod "getAttributes" o = EntryGetAttributesMethodInfo
    ResolveEntryMethod "getBaseline" o = Gtk.Widget.WidgetGetBaselineMethodInfo
    ResolveEntryMethod "getBounds" o = Gtk.Accessible.AccessibleGetBoundsMethodInfo
    ResolveEntryMethod "getBuffer" o = EntryGetBufferMethodInfo
    ResolveEntryMethod "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
    ResolveEntryMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveEntryMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveEntryMethod "getChars" o = Gtk.Editable.EditableGetCharsMethodInfo
    ResolveEntryMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveEntryMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveEntryMethod "getColor" o = Gtk.Widget.WidgetGetColorMethodInfo
    ResolveEntryMethod "getCompletion" o = EntryGetCompletionMethodInfo
    ResolveEntryMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveEntryMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveEntryMethod "getCurrentIconDragSource" o = EntryGetCurrentIconDragSourceMethodInfo
    ResolveEntryMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveEntryMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveEntryMethod "getDelegate" o = Gtk.Editable.EditableGetDelegateMethodInfo
    ResolveEntryMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveEntryMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveEntryMethod "getEditable" o = Gtk.Editable.EditableGetEditableMethodInfo
    ResolveEntryMethod "getEnableUndo" o = Gtk.Editable.EditableGetEnableUndoMethodInfo
    ResolveEntryMethod "getExtraMenu" o = EntryGetExtraMenuMethodInfo
    ResolveEntryMethod "getFirstAccessibleChild" o = Gtk.Accessible.AccessibleGetFirstAccessibleChildMethodInfo
    ResolveEntryMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveEntryMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveEntryMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveEntryMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolveEntryMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveEntryMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveEntryMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveEntryMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveEntryMethod "getHasFrame" o = EntryGetHasFrameMethodInfo
    ResolveEntryMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveEntryMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveEntryMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveEntryMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveEntryMethod "getIconActivatable" o = EntryGetIconActivatableMethodInfo
    ResolveEntryMethod "getIconArea" o = EntryGetIconAreaMethodInfo
    ResolveEntryMethod "getIconAtPos" o = EntryGetIconAtPosMethodInfo
    ResolveEntryMethod "getIconGicon" o = EntryGetIconGiconMethodInfo
    ResolveEntryMethod "getIconName" o = EntryGetIconNameMethodInfo
    ResolveEntryMethod "getIconPaintable" o = EntryGetIconPaintableMethodInfo
    ResolveEntryMethod "getIconSensitive" o = EntryGetIconSensitiveMethodInfo
    ResolveEntryMethod "getIconStorageType" o = EntryGetIconStorageTypeMethodInfo
    ResolveEntryMethod "getIconTooltipMarkup" o = EntryGetIconTooltipMarkupMethodInfo
    ResolveEntryMethod "getIconTooltipText" o = EntryGetIconTooltipTextMethodInfo
    ResolveEntryMethod "getInputHints" o = EntryGetInputHintsMethodInfo
    ResolveEntryMethod "getInputPurpose" o = EntryGetInputPurposeMethodInfo
    ResolveEntryMethod "getInvisibleChar" o = EntryGetInvisibleCharMethodInfo
    ResolveEntryMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveEntryMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveEntryMethod "getLimitEvents" o = Gtk.Widget.WidgetGetLimitEventsMethodInfo
    ResolveEntryMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveEntryMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveEntryMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveEntryMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveEntryMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveEntryMethod "getMaxLength" o = EntryGetMaxLengthMethodInfo
    ResolveEntryMethod "getMaxWidthChars" o = Gtk.Editable.EditableGetMaxWidthCharsMethodInfo
    ResolveEntryMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveEntryMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveEntryMethod "getNextAccessibleSibling" o = Gtk.Accessible.AccessibleGetNextAccessibleSiblingMethodInfo
    ResolveEntryMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveEntryMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveEntryMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveEntryMethod "getOverwriteMode" o = EntryGetOverwriteModeMethodInfo
    ResolveEntryMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveEntryMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveEntryMethod "getPlaceholderText" o = EntryGetPlaceholderTextMethodInfo
    ResolveEntryMethod "getPlatformState" o = Gtk.Accessible.AccessibleGetPlatformStateMethodInfo
    ResolveEntryMethod "getPosition" o = Gtk.Editable.EditableGetPositionMethodInfo
    ResolveEntryMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveEntryMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveEntryMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveEntryMethod "getProgressFraction" o = EntryGetProgressFractionMethodInfo
    ResolveEntryMethod "getProgressPulseStep" o = EntryGetProgressPulseStepMethodInfo
    ResolveEntryMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveEntryMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveEntryMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveEntryMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveEntryMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveEntryMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveEntryMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveEntryMethod "getSelectionBounds" o = Gtk.Editable.EditableGetSelectionBoundsMethodInfo
    ResolveEntryMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveEntryMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveEntryMethod "getSize" o = Gtk.Widget.WidgetGetSizeMethodInfo
    ResolveEntryMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveEntryMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveEntryMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveEntryMethod "getTabs" o = EntryGetTabsMethodInfo
    ResolveEntryMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveEntryMethod "getText" o = Gtk.Editable.EditableGetTextMethodInfo
    ResolveEntryMethod "getTextLength" o = EntryGetTextLengthMethodInfo
    ResolveEntryMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveEntryMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveEntryMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveEntryMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveEntryMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveEntryMethod "getVisibility" o = EntryGetVisibilityMethodInfo
    ResolveEntryMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveEntryMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveEntryMethod "getWidthChars" o = Gtk.Editable.EditableGetWidthCharsMethodInfo
    ResolveEntryMethod "setAccessibleParent" o = Gtk.Accessible.AccessibleSetAccessibleParentMethodInfo
    ResolveEntryMethod "setActivatesDefault" o = EntrySetActivatesDefaultMethodInfo
    ResolveEntryMethod "setAlignment" o = EntrySetAlignmentMethodInfo
    ResolveEntryMethod "setAttributes" o = EntrySetAttributesMethodInfo
    ResolveEntryMethod "setBuffer" o = EntrySetBufferMethodInfo
    ResolveEntryMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveEntryMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveEntryMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveEntryMethod "setCompletion" o = EntrySetCompletionMethodInfo
    ResolveEntryMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolveEntryMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveEntryMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveEntryMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveEntryMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveEntryMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveEntryMethod "setEditable" o = Gtk.Editable.EditableSetEditableMethodInfo
    ResolveEntryMethod "setEnableUndo" o = Gtk.Editable.EditableSetEnableUndoMethodInfo
    ResolveEntryMethod "setExtraMenu" o = EntrySetExtraMenuMethodInfo
    ResolveEntryMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveEntryMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveEntryMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveEntryMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveEntryMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveEntryMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveEntryMethod "setHasFrame" o = EntrySetHasFrameMethodInfo
    ResolveEntryMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveEntryMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveEntryMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveEntryMethod "setIconActivatable" o = EntrySetIconActivatableMethodInfo
    ResolveEntryMethod "setIconDragSource" o = EntrySetIconDragSourceMethodInfo
    ResolveEntryMethod "setIconFromGicon" o = EntrySetIconFromGiconMethodInfo
    ResolveEntryMethod "setIconFromIconName" o = EntrySetIconFromIconNameMethodInfo
    ResolveEntryMethod "setIconFromPaintable" o = EntrySetIconFromPaintableMethodInfo
    ResolveEntryMethod "setIconSensitive" o = EntrySetIconSensitiveMethodInfo
    ResolveEntryMethod "setIconTooltipMarkup" o = EntrySetIconTooltipMarkupMethodInfo
    ResolveEntryMethod "setIconTooltipText" o = EntrySetIconTooltipTextMethodInfo
    ResolveEntryMethod "setInputHints" o = EntrySetInputHintsMethodInfo
    ResolveEntryMethod "setInputPurpose" o = EntrySetInputPurposeMethodInfo
    ResolveEntryMethod "setInvisibleChar" o = EntrySetInvisibleCharMethodInfo
    ResolveEntryMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveEntryMethod "setLimitEvents" o = Gtk.Widget.WidgetSetLimitEventsMethodInfo
    ResolveEntryMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveEntryMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveEntryMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveEntryMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveEntryMethod "setMaxLength" o = EntrySetMaxLengthMethodInfo
    ResolveEntryMethod "setMaxWidthChars" o = Gtk.Editable.EditableSetMaxWidthCharsMethodInfo
    ResolveEntryMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveEntryMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveEntryMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveEntryMethod "setOverwriteMode" o = EntrySetOverwriteModeMethodInfo
    ResolveEntryMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveEntryMethod "setPlaceholderText" o = EntrySetPlaceholderTextMethodInfo
    ResolveEntryMethod "setPosition" o = Gtk.Editable.EditableSetPositionMethodInfo
    ResolveEntryMethod "setProgressFraction" o = EntrySetProgressFractionMethodInfo
    ResolveEntryMethod "setProgressPulseStep" o = EntrySetProgressPulseStepMethodInfo
    ResolveEntryMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveEntryMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveEntryMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveEntryMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveEntryMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveEntryMethod "setTabs" o = EntrySetTabsMethodInfo
    ResolveEntryMethod "setText" o = Gtk.Editable.EditableSetTextMethodInfo
    ResolveEntryMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveEntryMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveEntryMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveEntryMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveEntryMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveEntryMethod "setVisibility" o = EntrySetVisibilityMethodInfo
    ResolveEntryMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveEntryMethod "setWidthChars" o = Gtk.Editable.EditableSetWidthCharsMethodInfo
    ResolveEntryMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveEntryMethod t Entry, O.OverloadedMethod info Entry p) => OL.IsLabel t (Entry -> 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 ~ ResolveEntryMethod t Entry, O.OverloadedMethod info Entry p, R.HasField t Entry p) => R.HasField t Entry p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- signal Entry::activate
-- | Emitted when the entry is activated.
-- 
-- The keybindings for this signal are all forms of the Enter key.
type EntryActivateCallback =
    IO ()

type C_EntryActivateCallback =
    Ptr Entry ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_EntryActivateCallback :: 
    GObject a => (a -> EntryActivateCallback) ->
    C_EntryActivateCallback
wrap_EntryActivateCallback :: forall a. GObject a => (a -> IO ()) -> C_EntryActivateCallback
wrap_EntryActivateCallback a -> IO ()
gi'cb Ptr Entry
gi'selfPtr Ptr ()
_ = do
    Ptr Entry -> (Entry -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Entry
gi'selfPtr ((Entry -> IO ()) -> IO ()) -> (Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Entry
gi'self -> a -> IO ()
gi'cb (Entry -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Entry
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' entry #activate callback
-- @
-- 
-- 
onEntryActivate :: (IsEntry a, MonadIO m) => a -> ((?self :: a) => EntryActivateCallback) -> m SignalHandlerId
onEntryActivate :: forall a (m :: * -> *).
(IsEntry a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onEntryActivate 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_EntryActivateCallback
wrapped' = (a -> IO ()) -> C_EntryActivateCallback
forall a. GObject a => (a -> IO ()) -> C_EntryActivateCallback
wrap_EntryActivateCallback a -> IO ()
wrapped
    wrapped'' <- C_EntryActivateCallback -> IO (FunPtr C_EntryActivateCallback)
mk_EntryActivateCallback C_EntryActivateCallback
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' entry #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.
-- 
afterEntryActivate :: (IsEntry a, MonadIO m) => a -> ((?self :: a) => EntryActivateCallback) -> m SignalHandlerId
afterEntryActivate :: forall a (m :: * -> *).
(IsEntry a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterEntryActivate 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_EntryActivateCallback
wrapped' = (a -> IO ()) -> C_EntryActivateCallback
forall a. GObject a => (a -> IO ()) -> C_EntryActivateCallback
wrap_EntryActivateCallback a -> IO ()
wrapped
    wrapped'' <- C_EntryActivateCallback -> IO (FunPtr C_EntryActivateCallback)
mk_EntryActivateCallback C_EntryActivateCallback
wrapped'
    connectSignalFunPtr obj "activate" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data EntryActivateSignalInfo
instance SignalInfo EntryActivateSignalInfo where
    type HaskellCallbackType EntryActivateSignalInfo = EntryActivateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_EntryActivateCallback cb
        cb'' <- mk_EntryActivateCallback cb'
        connectSignalFunPtr obj "activate" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry::activate"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:signal:activate"})

#endif

-- signal Entry::icon-press
-- | Emitted when an activatable icon is clicked.
type EntryIconPressCallback =
    Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: The position of the clicked icon
    -> IO ()

type C_EntryIconPressCallback =
    Ptr Entry ->                            -- object
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_EntryIconPressCallback :: 
    GObject a => (a -> EntryIconPressCallback) ->
    C_EntryIconPressCallback
wrap_EntryIconPressCallback :: forall a.
GObject a =>
(a -> EntryIconPressCallback) -> C_EntryIconPressCallback
wrap_EntryIconPressCallback a -> EntryIconPressCallback
gi'cb Ptr Entry
gi'selfPtr CUInt
iconPos Ptr ()
_ = do
    let iconPos' :: EntryIconPosition
iconPos' = (Int -> EntryIconPosition
forall a. Enum a => Int -> a
toEnum (Int -> EntryIconPosition)
-> (CUInt -> Int) -> CUInt -> EntryIconPosition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
iconPos
    Ptr Entry -> (Entry -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Entry
gi'selfPtr ((Entry -> IO ()) -> IO ()) -> (Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Entry
gi'self -> a -> EntryIconPressCallback
gi'cb (Entry -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Entry
gi'self)  EntryIconPosition
iconPos'


-- | Connect a signal handler for the [iconPress](#signal:iconPress) 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' entry #iconPress callback
-- @
-- 
-- 
onEntryIconPress :: (IsEntry a, MonadIO m) => a -> ((?self :: a) => EntryIconPressCallback) -> m SignalHandlerId
onEntryIconPress :: forall a (m :: * -> *).
(IsEntry a, MonadIO m) =>
a -> ((?self::a) => EntryIconPressCallback) -> m SignalHandlerId
onEntryIconPress a
obj (?self::a) => EntryIconPressCallback
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 -> EntryIconPressCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => EntryIconPressCallback
EntryIconPressCallback
cb
    let wrapped' :: C_EntryIconPressCallback
wrapped' = (a -> EntryIconPressCallback) -> C_EntryIconPressCallback
forall a.
GObject a =>
(a -> EntryIconPressCallback) -> C_EntryIconPressCallback
wrap_EntryIconPressCallback a -> EntryIconPressCallback
wrapped
    wrapped'' <- C_EntryIconPressCallback -> IO (FunPtr C_EntryIconPressCallback)
mk_EntryIconPressCallback C_EntryIconPressCallback
wrapped'
    connectSignalFunPtr obj "icon-press" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [iconPress](#signal:iconPress) 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' entry #iconPress 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.
-- 
afterEntryIconPress :: (IsEntry a, MonadIO m) => a -> ((?self :: a) => EntryIconPressCallback) -> m SignalHandlerId
afterEntryIconPress :: forall a (m :: * -> *).
(IsEntry a, MonadIO m) =>
a -> ((?self::a) => EntryIconPressCallback) -> m SignalHandlerId
afterEntryIconPress a
obj (?self::a) => EntryIconPressCallback
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 -> EntryIconPressCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => EntryIconPressCallback
EntryIconPressCallback
cb
    let wrapped' :: C_EntryIconPressCallback
wrapped' = (a -> EntryIconPressCallback) -> C_EntryIconPressCallback
forall a.
GObject a =>
(a -> EntryIconPressCallback) -> C_EntryIconPressCallback
wrap_EntryIconPressCallback a -> EntryIconPressCallback
wrapped
    wrapped'' <- C_EntryIconPressCallback -> IO (FunPtr C_EntryIconPressCallback)
mk_EntryIconPressCallback C_EntryIconPressCallback
wrapped'
    connectSignalFunPtr obj "icon-press" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data EntryIconPressSignalInfo
instance SignalInfo EntryIconPressSignalInfo where
    type HaskellCallbackType EntryIconPressSignalInfo = EntryIconPressCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_EntryIconPressCallback cb
        cb'' <- mk_EntryIconPressCallback cb'
        connectSignalFunPtr obj "icon-press" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry::icon-press"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:signal:iconPress"})

#endif

-- signal Entry::icon-release
-- | Emitted on the button release from a mouse click
-- over an activatable icon.
type EntryIconReleaseCallback =
    Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: The position of the clicked icon
    -> IO ()

type C_EntryIconReleaseCallback =
    Ptr Entry ->                            -- object
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_EntryIconReleaseCallback :: 
    GObject a => (a -> EntryIconReleaseCallback) ->
    C_EntryIconReleaseCallback
wrap_EntryIconReleaseCallback :: forall a.
GObject a =>
(a -> EntryIconPressCallback) -> C_EntryIconPressCallback
wrap_EntryIconReleaseCallback a -> EntryIconPressCallback
gi'cb Ptr Entry
gi'selfPtr CUInt
iconPos Ptr ()
_ = do
    let iconPos' :: EntryIconPosition
iconPos' = (Int -> EntryIconPosition
forall a. Enum a => Int -> a
toEnum (Int -> EntryIconPosition)
-> (CUInt -> Int) -> CUInt -> EntryIconPosition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
iconPos
    Ptr Entry -> (Entry -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Entry
gi'selfPtr ((Entry -> IO ()) -> IO ()) -> (Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Entry
gi'self -> a -> EntryIconPressCallback
gi'cb (Entry -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Entry
gi'self)  EntryIconPosition
iconPos'


-- | Connect a signal handler for the [iconRelease](#signal:iconRelease) 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' entry #iconRelease callback
-- @
-- 
-- 
onEntryIconRelease :: (IsEntry a, MonadIO m) => a -> ((?self :: a) => EntryIconReleaseCallback) -> m SignalHandlerId
onEntryIconRelease :: forall a (m :: * -> *).
(IsEntry a, MonadIO m) =>
a -> ((?self::a) => EntryIconPressCallback) -> m SignalHandlerId
onEntryIconRelease a
obj (?self::a) => EntryIconPressCallback
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 -> EntryIconPressCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => EntryIconPressCallback
EntryIconPressCallback
cb
    let wrapped' :: C_EntryIconPressCallback
wrapped' = (a -> EntryIconPressCallback) -> C_EntryIconPressCallback
forall a.
GObject a =>
(a -> EntryIconPressCallback) -> C_EntryIconPressCallback
wrap_EntryIconReleaseCallback a -> EntryIconPressCallback
wrapped
    wrapped'' <- C_EntryIconPressCallback -> IO (FunPtr C_EntryIconPressCallback)
mk_EntryIconReleaseCallback C_EntryIconPressCallback
wrapped'
    connectSignalFunPtr obj "icon-release" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [iconRelease](#signal:iconRelease) 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' entry #iconRelease 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.
-- 
afterEntryIconRelease :: (IsEntry a, MonadIO m) => a -> ((?self :: a) => EntryIconReleaseCallback) -> m SignalHandlerId
afterEntryIconRelease :: forall a (m :: * -> *).
(IsEntry a, MonadIO m) =>
a -> ((?self::a) => EntryIconPressCallback) -> m SignalHandlerId
afterEntryIconRelease a
obj (?self::a) => EntryIconPressCallback
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 -> EntryIconPressCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => EntryIconPressCallback
EntryIconPressCallback
cb
    let wrapped' :: C_EntryIconPressCallback
wrapped' = (a -> EntryIconPressCallback) -> C_EntryIconPressCallback
forall a.
GObject a =>
(a -> EntryIconPressCallback) -> C_EntryIconPressCallback
wrap_EntryIconReleaseCallback a -> EntryIconPressCallback
wrapped
    wrapped'' <- C_EntryIconPressCallback -> IO (FunPtr C_EntryIconPressCallback)
mk_EntryIconReleaseCallback C_EntryIconPressCallback
wrapped'
    connectSignalFunPtr obj "icon-release" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data EntryIconReleaseSignalInfo
instance SignalInfo EntryIconReleaseSignalInfo where
    type HaskellCallbackType EntryIconReleaseSignalInfo = EntryIconReleaseCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_EntryIconReleaseCallback cb
        cb'' <- mk_EntryIconReleaseCallback cb'
        connectSignalFunPtr obj "icon-release" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry::icon-release"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:signal:iconRelease"})

#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' entry #activatesDefault
-- @
getEntryActivatesDefault :: (MonadIO m, IsEntry o) => o -> m Bool
getEntryActivatesDefault :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntryActivatesDefault 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' entry [ #activatesDefault 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryActivatesDefault :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryActivatesDefault :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryActivatesDefault 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`.
constructEntryActivatesDefault :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntryActivatesDefault :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntryActivatesDefault 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 EntryActivatesDefaultPropertyInfo
instance AttrInfo EntryActivatesDefaultPropertyInfo where
    type AttrAllowedOps EntryActivatesDefaultPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryActivatesDefaultPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryActivatesDefaultPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryActivatesDefaultPropertyInfo = (~) Bool
    type AttrTransferType EntryActivatesDefaultPropertyInfo = Bool
    type AttrGetType EntryActivatesDefaultPropertyInfo = Bool
    type AttrLabel EntryActivatesDefaultPropertyInfo = "activates-default"
    type AttrOrigin EntryActivatesDefaultPropertyInfo = Entry
    attrGet = getEntryActivatesDefault
    attrSet = setEntryActivatesDefault
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryActivatesDefault
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.activatesDefault"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:activatesDefault"
        })
#endif

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

-- | Get the value of the “@attributes@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #attributes
-- @
getEntryAttributes :: (MonadIO m, IsEntry o) => o -> m (Maybe Pango.AttrList.AttrList)
getEntryAttributes :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe AttrList)
getEntryAttributes 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' entry [ #attributes 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryAttributes :: (MonadIO m, IsEntry o) => o -> Pango.AttrList.AttrList -> m ()
setEntryAttributes :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> AttrList -> m ()
setEntryAttributes 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`.
constructEntryAttributes :: (IsEntry o, MIO.MonadIO m) => Pango.AttrList.AttrList -> m (GValueConstruct o)
constructEntryAttributes :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
AttrList -> m (GValueConstruct o)
constructEntryAttributes 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)

#if defined(ENABLE_OVERLOADING)
data EntryAttributesPropertyInfo
instance AttrInfo EntryAttributesPropertyInfo where
    type AttrAllowedOps EntryAttributesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryAttributesPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryAttributesPropertyInfo = (~) Pango.AttrList.AttrList
    type AttrTransferTypeConstraint EntryAttributesPropertyInfo = (~) Pango.AttrList.AttrList
    type AttrTransferType EntryAttributesPropertyInfo = Pango.AttrList.AttrList
    type AttrGetType EntryAttributesPropertyInfo = (Maybe Pango.AttrList.AttrList)
    type AttrLabel EntryAttributesPropertyInfo = "attributes"
    type AttrOrigin EntryAttributesPropertyInfo = Entry
    attrGet = getEntryAttributes
    attrSet = setEntryAttributes
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryAttributes
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.attributes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.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' entry #buffer
-- @
getEntryBuffer :: (MonadIO m, IsEntry o) => o -> m Gtk.EntryBuffer.EntryBuffer
getEntryBuffer :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m EntryBuffer
getEntryBuffer 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
"getEntryBuffer" (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' entry [ #buffer 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryBuffer :: (MonadIO m, IsEntry o, Gtk.EntryBuffer.IsEntryBuffer a) => o -> a -> m ()
setEntryBuffer :: forall (m :: * -> *) o a.
(MonadIO m, IsEntry o, IsEntryBuffer a) =>
o -> a -> m ()
setEntryBuffer 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`.
constructEntryBuffer :: (IsEntry o, MIO.MonadIO m, Gtk.EntryBuffer.IsEntryBuffer a) => a -> m (GValueConstruct o)
constructEntryBuffer :: forall o (m :: * -> *) a.
(IsEntry o, MonadIO m, IsEntryBuffer a) =>
a -> m (GValueConstruct o)
constructEntryBuffer 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 EntryBufferPropertyInfo
instance AttrInfo EntryBufferPropertyInfo where
    type AttrAllowedOps EntryBufferPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryBufferPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryBufferPropertyInfo = Gtk.EntryBuffer.IsEntryBuffer
    type AttrTransferTypeConstraint EntryBufferPropertyInfo = Gtk.EntryBuffer.IsEntryBuffer
    type AttrTransferType EntryBufferPropertyInfo = Gtk.EntryBuffer.EntryBuffer
    type AttrGetType EntryBufferPropertyInfo = Gtk.EntryBuffer.EntryBuffer
    type AttrLabel EntryBufferPropertyInfo = "buffer"
    type AttrOrigin EntryBufferPropertyInfo = Entry
    attrGet = getEntryBuffer
    attrSet = setEntryBuffer
    attrTransfer _ v = do
        unsafeCastTo Gtk.EntryBuffer.EntryBuffer v
    attrConstruct = constructEntryBuffer
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.buffer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:buffer"
        })
#endif

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

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

-- | Set the value of the “@completion@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #completion 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryCompletion :: (MonadIO m, IsEntry o, Gtk.EntryCompletion.IsEntryCompletion a) => o -> a -> m ()
setEntryCompletion :: forall (m :: * -> *) o a.
(MonadIO m, IsEntry o, IsEntryCompletion a) =>
o -> a -> m ()
setEntryCompletion 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
"completion" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@completion@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryCompletion :: (IsEntry o, MIO.MonadIO m, Gtk.EntryCompletion.IsEntryCompletion a) => a -> m (GValueConstruct o)
constructEntryCompletion :: forall o (m :: * -> *) a.
(IsEntry o, MonadIO m, IsEntryCompletion a) =>
a -> m (GValueConstruct o)
constructEntryCompletion 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
"completion" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@completion@” 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' #completion
-- @
clearEntryCompletion :: (MonadIO m, IsEntry o) => o -> m ()
clearEntryCompletion :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntryCompletion 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 EntryCompletion -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"completion" (Maybe EntryCompletion
forall a. Maybe a
Nothing :: Maybe Gtk.EntryCompletion.EntryCompletion)

#if defined(ENABLE_OVERLOADING)
data EntryCompletionPropertyInfo
instance AttrInfo EntryCompletionPropertyInfo where
    type AttrAllowedOps EntryCompletionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntryCompletionPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryCompletionPropertyInfo = Gtk.EntryCompletion.IsEntryCompletion
    type AttrTransferTypeConstraint EntryCompletionPropertyInfo = Gtk.EntryCompletion.IsEntryCompletion
    type AttrTransferType EntryCompletionPropertyInfo = Gtk.EntryCompletion.EntryCompletion
    type AttrGetType EntryCompletionPropertyInfo = (Maybe Gtk.EntryCompletion.EntryCompletion)
    type AttrLabel EntryCompletionPropertyInfo = "completion"
    type AttrOrigin EntryCompletionPropertyInfo = Entry
    attrGet = getEntryCompletion
    attrSet = setEntryCompletion
    attrTransfer _ v = do
        unsafeCastTo Gtk.EntryCompletion.EntryCompletion v
    attrConstruct = constructEntryCompletion
    attrClear = clearEntryCompletion
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.completion"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:completion"
        })
#endif

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

-- | Get the value of the “@enable-emoji-completion@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #enableEmojiCompletion
-- @
getEntryEnableEmojiCompletion :: (MonadIO m, IsEntry o) => o -> m Bool
getEntryEnableEmojiCompletion :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntryEnableEmojiCompletion 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' entry [ #enableEmojiCompletion 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryEnableEmojiCompletion :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryEnableEmojiCompletion :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryEnableEmojiCompletion 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`.
constructEntryEnableEmojiCompletion :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntryEnableEmojiCompletion :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntryEnableEmojiCompletion 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 EntryEnableEmojiCompletionPropertyInfo
instance AttrInfo EntryEnableEmojiCompletionPropertyInfo where
    type AttrAllowedOps EntryEnableEmojiCompletionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryEnableEmojiCompletionPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryEnableEmojiCompletionPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryEnableEmojiCompletionPropertyInfo = (~) Bool
    type AttrTransferType EntryEnableEmojiCompletionPropertyInfo = Bool
    type AttrGetType EntryEnableEmojiCompletionPropertyInfo = Bool
    type AttrLabel EntryEnableEmojiCompletionPropertyInfo = "enable-emoji-completion"
    type AttrOrigin EntryEnableEmojiCompletionPropertyInfo = Entry
    attrGet = getEntryEnableEmojiCompletion
    attrSet = setEntryEnableEmojiCompletion
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryEnableEmojiCompletion
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.enableEmojiCompletion"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.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' entry #extraMenu
-- @
getEntryExtraMenu :: (MonadIO m, IsEntry o) => o -> m (Maybe Gio.MenuModel.MenuModel)
getEntryExtraMenu :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe MenuModel)
getEntryExtraMenu 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' entry [ #extraMenu 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryExtraMenu :: (MonadIO m, IsEntry o, Gio.MenuModel.IsMenuModel a) => o -> a -> m ()
setEntryExtraMenu :: forall (m :: * -> *) o a.
(MonadIO m, IsEntry o, IsMenuModel a) =>
o -> a -> m ()
setEntryExtraMenu 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`.
constructEntryExtraMenu :: (IsEntry o, MIO.MonadIO m, Gio.MenuModel.IsMenuModel a) => a -> m (GValueConstruct o)
constructEntryExtraMenu :: forall o (m :: * -> *) a.
(IsEntry o, MonadIO m, IsMenuModel a) =>
a -> m (GValueConstruct o)
constructEntryExtraMenu 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
-- @
clearEntryExtraMenu :: (MonadIO m, IsEntry o) => o -> m ()
clearEntryExtraMenu :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntryExtraMenu 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 EntryExtraMenuPropertyInfo
instance AttrInfo EntryExtraMenuPropertyInfo where
    type AttrAllowedOps EntryExtraMenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntryExtraMenuPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryExtraMenuPropertyInfo = Gio.MenuModel.IsMenuModel
    type AttrTransferTypeConstraint EntryExtraMenuPropertyInfo = Gio.MenuModel.IsMenuModel
    type AttrTransferType EntryExtraMenuPropertyInfo = Gio.MenuModel.MenuModel
    type AttrGetType EntryExtraMenuPropertyInfo = (Maybe Gio.MenuModel.MenuModel)
    type AttrLabel EntryExtraMenuPropertyInfo = "extra-menu"
    type AttrOrigin EntryExtraMenuPropertyInfo = Entry
    attrGet = getEntryExtraMenu
    attrSet = setEntryExtraMenu
    attrTransfer _ v = do
        unsafeCastTo Gio.MenuModel.MenuModel v
    attrConstruct = constructEntryExtraMenu
    attrClear = clearEntryExtraMenu
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.extraMenu"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:extraMenu"
        })
#endif

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

-- | Get the value of the “@has-frame@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #hasFrame
-- @
getEntryHasFrame :: (MonadIO m, IsEntry o) => o -> m Bool
getEntryHasFrame :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntryHasFrame 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
"has-frame"

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

-- | Construct a t'GValueConstruct' with valid value for the “@has-frame@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryHasFrame :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntryHasFrame :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntryHasFrame 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
"has-frame" Bool
val

#if defined(ENABLE_OVERLOADING)
data EntryHasFramePropertyInfo
instance AttrInfo EntryHasFramePropertyInfo where
    type AttrAllowedOps EntryHasFramePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryHasFramePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryHasFramePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryHasFramePropertyInfo = (~) Bool
    type AttrTransferType EntryHasFramePropertyInfo = Bool
    type AttrGetType EntryHasFramePropertyInfo = Bool
    type AttrLabel EntryHasFramePropertyInfo = "has-frame"
    type AttrOrigin EntryHasFramePropertyInfo = Entry
    attrGet = getEntryHasFrame
    attrSet = setEntryHasFrame
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryHasFrame
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.hasFrame"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:hasFrame"
        })
#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' entry #imModule
-- @
getEntryImModule :: (MonadIO m, IsEntry o) => o -> m (Maybe T.Text)
getEntryImModule :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe Text)
getEntryImModule 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' entry [ #imModule 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryImModule :: (MonadIO m, IsEntry o) => o -> T.Text -> m ()
setEntryImModule :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Text -> m ()
setEntryImModule 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`.
constructEntryImModule :: (IsEntry o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEntryImModule :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEntryImModule 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
-- @
clearEntryImModule :: (MonadIO m, IsEntry o) => o -> m ()
clearEntryImModule :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntryImModule 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 EntryImModulePropertyInfo
instance AttrInfo EntryImModulePropertyInfo where
    type AttrAllowedOps EntryImModulePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntryImModulePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryImModulePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EntryImModulePropertyInfo = (~) T.Text
    type AttrTransferType EntryImModulePropertyInfo = T.Text
    type AttrGetType EntryImModulePropertyInfo = (Maybe T.Text)
    type AttrLabel EntryImModulePropertyInfo = "im-module"
    type AttrOrigin EntryImModulePropertyInfo = Entry
    attrGet = getEntryImModule
    attrSet = setEntryImModule
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryImModule
    attrClear = clearEntryImModule
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.imModule"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.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' entry #inputHints
-- @
getEntryInputHints :: (MonadIO m, IsEntry o) => o -> m [Gtk.Flags.InputHints]
getEntryInputHints :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m [InputHints]
getEntryInputHints 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' entry [ #inputHints 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryInputHints :: (MonadIO m, IsEntry o) => o -> [Gtk.Flags.InputHints] -> m ()
setEntryInputHints :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> [InputHints] -> m ()
setEntryInputHints 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`.
constructEntryInputHints :: (IsEntry o, MIO.MonadIO m) => [Gtk.Flags.InputHints] -> m (GValueConstruct o)
constructEntryInputHints :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
[InputHints] -> m (GValueConstruct o)
constructEntryInputHints [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 EntryInputHintsPropertyInfo
instance AttrInfo EntryInputHintsPropertyInfo where
    type AttrAllowedOps EntryInputHintsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryInputHintsPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryInputHintsPropertyInfo = (~) [Gtk.Flags.InputHints]
    type AttrTransferTypeConstraint EntryInputHintsPropertyInfo = (~) [Gtk.Flags.InputHints]
    type AttrTransferType EntryInputHintsPropertyInfo = [Gtk.Flags.InputHints]
    type AttrGetType EntryInputHintsPropertyInfo = [Gtk.Flags.InputHints]
    type AttrLabel EntryInputHintsPropertyInfo = "input-hints"
    type AttrOrigin EntryInputHintsPropertyInfo = Entry
    attrGet = getEntryInputHints
    attrSet = setEntryInputHints
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryInputHints
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.inputHints"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.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' entry #inputPurpose
-- @
getEntryInputPurpose :: (MonadIO m, IsEntry o) => o -> m Gtk.Enums.InputPurpose
getEntryInputPurpose :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m InputPurpose
getEntryInputPurpose 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' entry [ #inputPurpose 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryInputPurpose :: (MonadIO m, IsEntry o) => o -> Gtk.Enums.InputPurpose -> m ()
setEntryInputPurpose :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> InputPurpose -> m ()
setEntryInputPurpose 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`.
constructEntryInputPurpose :: (IsEntry o, MIO.MonadIO m) => Gtk.Enums.InputPurpose -> m (GValueConstruct o)
constructEntryInputPurpose :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
InputPurpose -> m (GValueConstruct o)
constructEntryInputPurpose 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 EntryInputPurposePropertyInfo
instance AttrInfo EntryInputPurposePropertyInfo where
    type AttrAllowedOps EntryInputPurposePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryInputPurposePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryInputPurposePropertyInfo = (~) Gtk.Enums.InputPurpose
    type AttrTransferTypeConstraint EntryInputPurposePropertyInfo = (~) Gtk.Enums.InputPurpose
    type AttrTransferType EntryInputPurposePropertyInfo = Gtk.Enums.InputPurpose
    type AttrGetType EntryInputPurposePropertyInfo = Gtk.Enums.InputPurpose
    type AttrLabel EntryInputPurposePropertyInfo = "input-purpose"
    type AttrOrigin EntryInputPurposePropertyInfo = Entry
    attrGet = getEntryInputPurpose
    attrSet = setEntryInputPurpose
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryInputPurpose
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.inputPurpose"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.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' entry #invisibleChar
-- @
getEntryInvisibleChar :: (MonadIO m, IsEntry o) => o -> m Word32
getEntryInvisibleChar :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Word32
getEntryInvisibleChar 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' entry [ #invisibleChar 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryInvisibleChar :: (MonadIO m, IsEntry o) => o -> Word32 -> m ()
setEntryInvisibleChar :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> Word32 -> m ()
setEntryInvisibleChar 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`.
constructEntryInvisibleChar :: (IsEntry o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructEntryInvisibleChar :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructEntryInvisibleChar 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 EntryInvisibleCharPropertyInfo
instance AttrInfo EntryInvisibleCharPropertyInfo where
    type AttrAllowedOps EntryInvisibleCharPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryInvisibleCharPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryInvisibleCharPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint EntryInvisibleCharPropertyInfo = (~) Word32
    type AttrTransferType EntryInvisibleCharPropertyInfo = Word32
    type AttrGetType EntryInvisibleCharPropertyInfo = Word32
    type AttrLabel EntryInvisibleCharPropertyInfo = "invisible-char"
    type AttrOrigin EntryInvisibleCharPropertyInfo = Entry
    attrGet = getEntryInvisibleChar
    attrSet = setEntryInvisibleChar
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryInvisibleChar
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.invisibleChar"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.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' entry #invisibleCharSet
-- @
getEntryInvisibleCharSet :: (MonadIO m, IsEntry o) => o -> m Bool
getEntryInvisibleCharSet :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntryInvisibleCharSet 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' entry [ #invisibleCharSet 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryInvisibleCharSet :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryInvisibleCharSet :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryInvisibleCharSet 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`.
constructEntryInvisibleCharSet :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntryInvisibleCharSet :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntryInvisibleCharSet 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 EntryInvisibleCharSetPropertyInfo
instance AttrInfo EntryInvisibleCharSetPropertyInfo where
    type AttrAllowedOps EntryInvisibleCharSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryInvisibleCharSetPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryInvisibleCharSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryInvisibleCharSetPropertyInfo = (~) Bool
    type AttrTransferType EntryInvisibleCharSetPropertyInfo = Bool
    type AttrGetType EntryInvisibleCharSetPropertyInfo = Bool
    type AttrLabel EntryInvisibleCharSetPropertyInfo = "invisible-char-set"
    type AttrOrigin EntryInvisibleCharSetPropertyInfo = Entry
    attrGet = getEntryInvisibleCharSet
    attrSet = setEntryInvisibleCharSet
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryInvisibleCharSet
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.invisibleCharSet"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.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' entry #maxLength
-- @
getEntryMaxLength :: (MonadIO m, IsEntry o) => o -> m Int32
getEntryMaxLength :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Int32
getEntryMaxLength 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' entry [ #maxLength 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryMaxLength :: (MonadIO m, IsEntry o) => o -> Int32 -> m ()
setEntryMaxLength :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> Int32 -> m ()
setEntryMaxLength 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`.
constructEntryMaxLength :: (IsEntry o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructEntryMaxLength :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructEntryMaxLength 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 EntryMaxLengthPropertyInfo
instance AttrInfo EntryMaxLengthPropertyInfo where
    type AttrAllowedOps EntryMaxLengthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryMaxLengthPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryMaxLengthPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint EntryMaxLengthPropertyInfo = (~) Int32
    type AttrTransferType EntryMaxLengthPropertyInfo = Int32
    type AttrGetType EntryMaxLengthPropertyInfo = Int32
    type AttrLabel EntryMaxLengthPropertyInfo = "max-length"
    type AttrOrigin EntryMaxLengthPropertyInfo = Entry
    attrGet = getEntryMaxLength
    attrSet = setEntryMaxLength
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryMaxLength
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.maxLength"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.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' entry #overwriteMode
-- @
getEntryOverwriteMode :: (MonadIO m, IsEntry o) => o -> m Bool
getEntryOverwriteMode :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntryOverwriteMode 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' entry [ #overwriteMode 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryOverwriteMode :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryOverwriteMode :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryOverwriteMode 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`.
constructEntryOverwriteMode :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntryOverwriteMode :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntryOverwriteMode 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 EntryOverwriteModePropertyInfo
instance AttrInfo EntryOverwriteModePropertyInfo where
    type AttrAllowedOps EntryOverwriteModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryOverwriteModePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryOverwriteModePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryOverwriteModePropertyInfo = (~) Bool
    type AttrTransferType EntryOverwriteModePropertyInfo = Bool
    type AttrGetType EntryOverwriteModePropertyInfo = Bool
    type AttrLabel EntryOverwriteModePropertyInfo = "overwrite-mode"
    type AttrOrigin EntryOverwriteModePropertyInfo = Entry
    attrGet = getEntryOverwriteMode
    attrSet = setEntryOverwriteMode
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryOverwriteMode
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.overwriteMode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.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' entry #placeholderText
-- @
getEntryPlaceholderText :: (MonadIO m, IsEntry o) => o -> m (Maybe T.Text)
getEntryPlaceholderText :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe Text)
getEntryPlaceholderText 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' entry [ #placeholderText 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryPlaceholderText :: (MonadIO m, IsEntry o) => o -> T.Text -> m ()
setEntryPlaceholderText :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Text -> m ()
setEntryPlaceholderText 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`.
constructEntryPlaceholderText :: (IsEntry o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEntryPlaceholderText :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEntryPlaceholderText 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
-- @
clearEntryPlaceholderText :: (MonadIO m, IsEntry o) => o -> m ()
clearEntryPlaceholderText :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntryPlaceholderText 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 EntryPlaceholderTextPropertyInfo
instance AttrInfo EntryPlaceholderTextPropertyInfo where
    type AttrAllowedOps EntryPlaceholderTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntryPlaceholderTextPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryPlaceholderTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EntryPlaceholderTextPropertyInfo = (~) T.Text
    type AttrTransferType EntryPlaceholderTextPropertyInfo = T.Text
    type AttrGetType EntryPlaceholderTextPropertyInfo = (Maybe T.Text)
    type AttrLabel EntryPlaceholderTextPropertyInfo = "placeholder-text"
    type AttrOrigin EntryPlaceholderTextPropertyInfo = Entry
    attrGet = getEntryPlaceholderText
    attrSet = setEntryPlaceholderText
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryPlaceholderText
    attrClear = clearEntryPlaceholderText
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.placeholderText"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:placeholderText"
        })
#endif

-- VVV Prop "primary-icon-activatable"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@primary-icon-activatable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #primaryIconActivatable
-- @
getEntryPrimaryIconActivatable :: (MonadIO m, IsEntry o) => o -> m Bool
getEntryPrimaryIconActivatable :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntryPrimaryIconActivatable 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
"primary-icon-activatable"

-- | Set the value of the “@primary-icon-activatable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #primaryIconActivatable 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryPrimaryIconActivatable :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryPrimaryIconActivatable :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryPrimaryIconActivatable 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
"primary-icon-activatable" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@primary-icon-activatable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryPrimaryIconActivatable :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntryPrimaryIconActivatable :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntryPrimaryIconActivatable 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
"primary-icon-activatable" Bool
val

#if defined(ENABLE_OVERLOADING)
data EntryPrimaryIconActivatablePropertyInfo
instance AttrInfo EntryPrimaryIconActivatablePropertyInfo where
    type AttrAllowedOps EntryPrimaryIconActivatablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryPrimaryIconActivatablePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryPrimaryIconActivatablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryPrimaryIconActivatablePropertyInfo = (~) Bool
    type AttrTransferType EntryPrimaryIconActivatablePropertyInfo = Bool
    type AttrGetType EntryPrimaryIconActivatablePropertyInfo = Bool
    type AttrLabel EntryPrimaryIconActivatablePropertyInfo = "primary-icon-activatable"
    type AttrOrigin EntryPrimaryIconActivatablePropertyInfo = Entry
    attrGet = getEntryPrimaryIconActivatable
    attrSet = setEntryPrimaryIconActivatable
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryPrimaryIconActivatable
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.primaryIconActivatable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:primaryIconActivatable"
        })
#endif

-- VVV Prop "primary-icon-gicon"
   -- Type: TInterface (Name {namespace = "Gio", name = "Icon"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@primary-icon-gicon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #primaryIconGicon 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryPrimaryIconGicon :: (MonadIO m, IsEntry o, Gio.Icon.IsIcon a) => o -> a -> m ()
setEntryPrimaryIconGicon :: forall (m :: * -> *) o a.
(MonadIO m, IsEntry o, IsIcon a) =>
o -> a -> m ()
setEntryPrimaryIconGicon 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
"primary-icon-gicon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@primary-icon-gicon@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryPrimaryIconGicon :: (IsEntry o, MIO.MonadIO m, Gio.Icon.IsIcon a) => a -> m (GValueConstruct o)
constructEntryPrimaryIconGicon :: forall o (m :: * -> *) a.
(IsEntry o, MonadIO m, IsIcon a) =>
a -> m (GValueConstruct o)
constructEntryPrimaryIconGicon 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
"primary-icon-gicon" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@primary-icon-gicon@” 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' #primaryIconGicon
-- @
clearEntryPrimaryIconGicon :: (MonadIO m, IsEntry o) => o -> m ()
clearEntryPrimaryIconGicon :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntryPrimaryIconGicon 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 Icon -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"primary-icon-gicon" (Maybe Icon
forall a. Maybe a
Nothing :: Maybe Gio.Icon.Icon)

#if defined(ENABLE_OVERLOADING)
data EntryPrimaryIconGiconPropertyInfo
instance AttrInfo EntryPrimaryIconGiconPropertyInfo where
    type AttrAllowedOps EntryPrimaryIconGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntryPrimaryIconGiconPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryPrimaryIconGiconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferTypeConstraint EntryPrimaryIconGiconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferType EntryPrimaryIconGiconPropertyInfo = Gio.Icon.Icon
    type AttrGetType EntryPrimaryIconGiconPropertyInfo = (Maybe Gio.Icon.Icon)
    type AttrLabel EntryPrimaryIconGiconPropertyInfo = "primary-icon-gicon"
    type AttrOrigin EntryPrimaryIconGiconPropertyInfo = Entry
    attrGet = getEntryPrimaryIconGicon
    attrSet = setEntryPrimaryIconGicon
    attrTransfer _ v = do
        unsafeCastTo Gio.Icon.Icon v
    attrConstruct = constructEntryPrimaryIconGicon
    attrClear = clearEntryPrimaryIconGicon
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.primaryIconGicon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:primaryIconGicon"
        })
#endif

-- VVV Prop "primary-icon-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@primary-icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #primaryIconName
-- @
getEntryPrimaryIconName :: (MonadIO m, IsEntry o) => o -> m (Maybe T.Text)
getEntryPrimaryIconName :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe Text)
getEntryPrimaryIconName 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
"primary-icon-name"

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

-- | Construct a t'GValueConstruct' with valid value for the “@primary-icon-name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryPrimaryIconName :: (IsEntry o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEntryPrimaryIconName :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEntryPrimaryIconName 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
"primary-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@primary-icon-name@” 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' #primaryIconName
-- @
clearEntryPrimaryIconName :: (MonadIO m, IsEntry o) => o -> m ()
clearEntryPrimaryIconName :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntryPrimaryIconName 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
"primary-icon-name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data EntryPrimaryIconNamePropertyInfo
instance AttrInfo EntryPrimaryIconNamePropertyInfo where
    type AttrAllowedOps EntryPrimaryIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntryPrimaryIconNamePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryPrimaryIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EntryPrimaryIconNamePropertyInfo = (~) T.Text
    type AttrTransferType EntryPrimaryIconNamePropertyInfo = T.Text
    type AttrGetType EntryPrimaryIconNamePropertyInfo = (Maybe T.Text)
    type AttrLabel EntryPrimaryIconNamePropertyInfo = "primary-icon-name"
    type AttrOrigin EntryPrimaryIconNamePropertyInfo = Entry
    attrGet = getEntryPrimaryIconName
    attrSet = setEntryPrimaryIconName
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryPrimaryIconName
    attrClear = clearEntryPrimaryIconName
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.primaryIconName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:primaryIconName"
        })
#endif

-- VVV Prop "primary-icon-paintable"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Paintable"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@primary-icon-paintable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #primaryIconPaintable
-- @
getEntryPrimaryIconPaintable :: (MonadIO m, IsEntry o) => o -> m (Maybe Gdk.Paintable.Paintable)
getEntryPrimaryIconPaintable :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe Paintable)
getEntryPrimaryIconPaintable o
obj = IO (Maybe Paintable) -> m (Maybe Paintable)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Paintable) -> m (Maybe Paintable))
-> IO (Maybe Paintable) -> m (Maybe Paintable)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr Paintable -> Paintable)
-> IO (Maybe Paintable)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"primary-icon-paintable" ManagedPtr Paintable -> Paintable
Gdk.Paintable.Paintable

-- | Set the value of the “@primary-icon-paintable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #primaryIconPaintable 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryPrimaryIconPaintable :: (MonadIO m, IsEntry o, Gdk.Paintable.IsPaintable a) => o -> a -> m ()
setEntryPrimaryIconPaintable :: forall (m :: * -> *) o a.
(MonadIO m, IsEntry o, IsPaintable a) =>
o -> a -> m ()
setEntryPrimaryIconPaintable 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
"primary-icon-paintable" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@primary-icon-paintable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryPrimaryIconPaintable :: (IsEntry o, MIO.MonadIO m, Gdk.Paintable.IsPaintable a) => a -> m (GValueConstruct o)
constructEntryPrimaryIconPaintable :: forall o (m :: * -> *) a.
(IsEntry o, MonadIO m, IsPaintable a) =>
a -> m (GValueConstruct o)
constructEntryPrimaryIconPaintable 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
"primary-icon-paintable" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@primary-icon-paintable@” 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' #primaryIconPaintable
-- @
clearEntryPrimaryIconPaintable :: (MonadIO m, IsEntry o) => o -> m ()
clearEntryPrimaryIconPaintable :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntryPrimaryIconPaintable 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 Paintable -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"primary-icon-paintable" (Maybe Paintable
forall a. Maybe a
Nothing :: Maybe Gdk.Paintable.Paintable)

#if defined(ENABLE_OVERLOADING)
data EntryPrimaryIconPaintablePropertyInfo
instance AttrInfo EntryPrimaryIconPaintablePropertyInfo where
    type AttrAllowedOps EntryPrimaryIconPaintablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntryPrimaryIconPaintablePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryPrimaryIconPaintablePropertyInfo = Gdk.Paintable.IsPaintable
    type AttrTransferTypeConstraint EntryPrimaryIconPaintablePropertyInfo = Gdk.Paintable.IsPaintable
    type AttrTransferType EntryPrimaryIconPaintablePropertyInfo = Gdk.Paintable.Paintable
    type AttrGetType EntryPrimaryIconPaintablePropertyInfo = (Maybe Gdk.Paintable.Paintable)
    type AttrLabel EntryPrimaryIconPaintablePropertyInfo = "primary-icon-paintable"
    type AttrOrigin EntryPrimaryIconPaintablePropertyInfo = Entry
    attrGet = getEntryPrimaryIconPaintable
    attrSet = setEntryPrimaryIconPaintable
    attrTransfer _ v = do
        unsafeCastTo Gdk.Paintable.Paintable v
    attrConstruct = constructEntryPrimaryIconPaintable
    attrClear = clearEntryPrimaryIconPaintable
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.primaryIconPaintable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:primaryIconPaintable"
        })
#endif

-- VVV Prop "primary-icon-sensitive"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@primary-icon-sensitive@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #primaryIconSensitive
-- @
getEntryPrimaryIconSensitive :: (MonadIO m, IsEntry o) => o -> m Bool
getEntryPrimaryIconSensitive :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntryPrimaryIconSensitive 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
"primary-icon-sensitive"

-- | Set the value of the “@primary-icon-sensitive@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #primaryIconSensitive 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryPrimaryIconSensitive :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryPrimaryIconSensitive :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryPrimaryIconSensitive 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
"primary-icon-sensitive" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@primary-icon-sensitive@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryPrimaryIconSensitive :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntryPrimaryIconSensitive :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntryPrimaryIconSensitive 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
"primary-icon-sensitive" Bool
val

#if defined(ENABLE_OVERLOADING)
data EntryPrimaryIconSensitivePropertyInfo
instance AttrInfo EntryPrimaryIconSensitivePropertyInfo where
    type AttrAllowedOps EntryPrimaryIconSensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryPrimaryIconSensitivePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryPrimaryIconSensitivePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryPrimaryIconSensitivePropertyInfo = (~) Bool
    type AttrTransferType EntryPrimaryIconSensitivePropertyInfo = Bool
    type AttrGetType EntryPrimaryIconSensitivePropertyInfo = Bool
    type AttrLabel EntryPrimaryIconSensitivePropertyInfo = "primary-icon-sensitive"
    type AttrOrigin EntryPrimaryIconSensitivePropertyInfo = Entry
    attrGet = getEntryPrimaryIconSensitive
    attrSet = setEntryPrimaryIconSensitive
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryPrimaryIconSensitive
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.primaryIconSensitive"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:primaryIconSensitive"
        })
#endif

-- VVV Prop "primary-icon-storage-type"
   -- Type: TInterface (Name {namespace = "Gtk", name = "ImageType"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@primary-icon-storage-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #primaryIconStorageType
-- @
getEntryPrimaryIconStorageType :: (MonadIO m, IsEntry o) => o -> m Gtk.Enums.ImageType
getEntryPrimaryIconStorageType :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ImageType
getEntryPrimaryIconStorageType o
obj = IO ImageType -> m ImageType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ImageType -> m ImageType) -> IO ImageType -> m ImageType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ImageType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"primary-icon-storage-type"

#if defined(ENABLE_OVERLOADING)
data EntryPrimaryIconStorageTypePropertyInfo
instance AttrInfo EntryPrimaryIconStorageTypePropertyInfo where
    type AttrAllowedOps EntryPrimaryIconStorageTypePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint EntryPrimaryIconStorageTypePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryPrimaryIconStorageTypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint EntryPrimaryIconStorageTypePropertyInfo = (~) ()
    type AttrTransferType EntryPrimaryIconStorageTypePropertyInfo = ()
    type AttrGetType EntryPrimaryIconStorageTypePropertyInfo = Gtk.Enums.ImageType
    type AttrLabel EntryPrimaryIconStorageTypePropertyInfo = "primary-icon-storage-type"
    type AttrOrigin EntryPrimaryIconStorageTypePropertyInfo = Entry
    attrGet = getEntryPrimaryIconStorageType
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.primaryIconStorageType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:primaryIconStorageType"
        })
#endif

-- VVV Prop "primary-icon-tooltip-markup"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@primary-icon-tooltip-markup@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #primaryIconTooltipMarkup
-- @
getEntryPrimaryIconTooltipMarkup :: (MonadIO m, IsEntry o) => o -> m (Maybe T.Text)
getEntryPrimaryIconTooltipMarkup :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe Text)
getEntryPrimaryIconTooltipMarkup 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
"primary-icon-tooltip-markup"

-- | Set the value of the “@primary-icon-tooltip-markup@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #primaryIconTooltipMarkup 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryPrimaryIconTooltipMarkup :: (MonadIO m, IsEntry o) => o -> T.Text -> m ()
setEntryPrimaryIconTooltipMarkup :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Text -> m ()
setEntryPrimaryIconTooltipMarkup 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
"primary-icon-tooltip-markup" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a t'GValueConstruct' with valid value for the “@primary-icon-tooltip-markup@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryPrimaryIconTooltipMarkup :: (IsEntry o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEntryPrimaryIconTooltipMarkup :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEntryPrimaryIconTooltipMarkup 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
"primary-icon-tooltip-markup" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@primary-icon-tooltip-markup@” 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' #primaryIconTooltipMarkup
-- @
clearEntryPrimaryIconTooltipMarkup :: (MonadIO m, IsEntry o) => o -> m ()
clearEntryPrimaryIconTooltipMarkup :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntryPrimaryIconTooltipMarkup 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
"primary-icon-tooltip-markup" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data EntryPrimaryIconTooltipMarkupPropertyInfo
instance AttrInfo EntryPrimaryIconTooltipMarkupPropertyInfo where
    type AttrAllowedOps EntryPrimaryIconTooltipMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntryPrimaryIconTooltipMarkupPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryPrimaryIconTooltipMarkupPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EntryPrimaryIconTooltipMarkupPropertyInfo = (~) T.Text
    type AttrTransferType EntryPrimaryIconTooltipMarkupPropertyInfo = T.Text
    type AttrGetType EntryPrimaryIconTooltipMarkupPropertyInfo = (Maybe T.Text)
    type AttrLabel EntryPrimaryIconTooltipMarkupPropertyInfo = "primary-icon-tooltip-markup"
    type AttrOrigin EntryPrimaryIconTooltipMarkupPropertyInfo = Entry
    attrGet = getEntryPrimaryIconTooltipMarkup
    attrSet = setEntryPrimaryIconTooltipMarkup
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryPrimaryIconTooltipMarkup
    attrClear = clearEntryPrimaryIconTooltipMarkup
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.primaryIconTooltipMarkup"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:primaryIconTooltipMarkup"
        })
#endif

-- VVV Prop "primary-icon-tooltip-text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@primary-icon-tooltip-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #primaryIconTooltipText
-- @
getEntryPrimaryIconTooltipText :: (MonadIO m, IsEntry o) => o -> m (Maybe T.Text)
getEntryPrimaryIconTooltipText :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe Text)
getEntryPrimaryIconTooltipText 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
"primary-icon-tooltip-text"

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

-- | Construct a t'GValueConstruct' with valid value for the “@primary-icon-tooltip-text@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryPrimaryIconTooltipText :: (IsEntry o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEntryPrimaryIconTooltipText :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEntryPrimaryIconTooltipText 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
"primary-icon-tooltip-text" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@primary-icon-tooltip-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' #primaryIconTooltipText
-- @
clearEntryPrimaryIconTooltipText :: (MonadIO m, IsEntry o) => o -> m ()
clearEntryPrimaryIconTooltipText :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntryPrimaryIconTooltipText 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
"primary-icon-tooltip-text" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data EntryPrimaryIconTooltipTextPropertyInfo
instance AttrInfo EntryPrimaryIconTooltipTextPropertyInfo where
    type AttrAllowedOps EntryPrimaryIconTooltipTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntryPrimaryIconTooltipTextPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryPrimaryIconTooltipTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EntryPrimaryIconTooltipTextPropertyInfo = (~) T.Text
    type AttrTransferType EntryPrimaryIconTooltipTextPropertyInfo = T.Text
    type AttrGetType EntryPrimaryIconTooltipTextPropertyInfo = (Maybe T.Text)
    type AttrLabel EntryPrimaryIconTooltipTextPropertyInfo = "primary-icon-tooltip-text"
    type AttrOrigin EntryPrimaryIconTooltipTextPropertyInfo = Entry
    attrGet = getEntryPrimaryIconTooltipText
    attrSet = setEntryPrimaryIconTooltipText
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryPrimaryIconTooltipText
    attrClear = clearEntryPrimaryIconTooltipText
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.primaryIconTooltipText"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:primaryIconTooltipText"
        })
#endif

-- VVV Prop "progress-fraction"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@progress-fraction@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #progressFraction 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryProgressFraction :: (MonadIO m, IsEntry o) => o -> Double -> m ()
setEntryProgressFraction :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> Double -> m ()
setEntryProgressFraction o
obj Double
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 -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"progress-fraction" Double
val

-- | Construct a t'GValueConstruct' with valid value for the “@progress-fraction@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryProgressFraction :: (IsEntry o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructEntryProgressFraction :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructEntryProgressFraction Double
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 -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"progress-fraction" Double
val

#if defined(ENABLE_OVERLOADING)
data EntryProgressFractionPropertyInfo
instance AttrInfo EntryProgressFractionPropertyInfo where
    type AttrAllowedOps EntryProgressFractionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryProgressFractionPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryProgressFractionPropertyInfo = (~) Double
    type AttrTransferTypeConstraint EntryProgressFractionPropertyInfo = (~) Double
    type AttrTransferType EntryProgressFractionPropertyInfo = Double
    type AttrGetType EntryProgressFractionPropertyInfo = Double
    type AttrLabel EntryProgressFractionPropertyInfo = "progress-fraction"
    type AttrOrigin EntryProgressFractionPropertyInfo = Entry
    attrGet = getEntryProgressFraction
    attrSet = setEntryProgressFraction
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryProgressFraction
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.progressFraction"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:progressFraction"
        })
#endif

-- VVV Prop "progress-pulse-step"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@progress-pulse-step@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #progressPulseStep
-- @
getEntryProgressPulseStep :: (MonadIO m, IsEntry o) => o -> m Double
getEntryProgressPulseStep :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Double
getEntryProgressPulseStep o
obj = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"progress-pulse-step"

-- | Set the value of the “@progress-pulse-step@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #progressPulseStep 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryProgressPulseStep :: (MonadIO m, IsEntry o) => o -> Double -> m ()
setEntryProgressPulseStep :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> Double -> m ()
setEntryProgressPulseStep o
obj Double
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 -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"progress-pulse-step" Double
val

-- | Construct a t'GValueConstruct' with valid value for the “@progress-pulse-step@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryProgressPulseStep :: (IsEntry o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructEntryProgressPulseStep :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructEntryProgressPulseStep Double
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 -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"progress-pulse-step" Double
val

#if defined(ENABLE_OVERLOADING)
data EntryProgressPulseStepPropertyInfo
instance AttrInfo EntryProgressPulseStepPropertyInfo where
    type AttrAllowedOps EntryProgressPulseStepPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryProgressPulseStepPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryProgressPulseStepPropertyInfo = (~) Double
    type AttrTransferTypeConstraint EntryProgressPulseStepPropertyInfo = (~) Double
    type AttrTransferType EntryProgressPulseStepPropertyInfo = Double
    type AttrGetType EntryProgressPulseStepPropertyInfo = Double
    type AttrLabel EntryProgressPulseStepPropertyInfo = "progress-pulse-step"
    type AttrOrigin EntryProgressPulseStepPropertyInfo = Entry
    attrGet = getEntryProgressPulseStep
    attrSet = setEntryProgressPulseStep
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryProgressPulseStep
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.progressPulseStep"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:progressPulseStep"
        })
#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' entry #scrollOffset
-- @
getEntryScrollOffset :: (MonadIO m, IsEntry o) => o -> m Int32
getEntryScrollOffset :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Int32
getEntryScrollOffset 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 EntryScrollOffsetPropertyInfo
instance AttrInfo EntryScrollOffsetPropertyInfo where
    type AttrAllowedOps EntryScrollOffsetPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint EntryScrollOffsetPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryScrollOffsetPropertyInfo = (~) ()
    type AttrTransferTypeConstraint EntryScrollOffsetPropertyInfo = (~) ()
    type AttrTransferType EntryScrollOffsetPropertyInfo = ()
    type AttrGetType EntryScrollOffsetPropertyInfo = Int32
    type AttrLabel EntryScrollOffsetPropertyInfo = "scroll-offset"
    type AttrOrigin EntryScrollOffsetPropertyInfo = Entry
    attrGet = getEntryScrollOffset
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.scrollOffset"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:scrollOffset"
        })
#endif

-- VVV Prop "secondary-icon-activatable"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@secondary-icon-activatable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #secondaryIconActivatable
-- @
getEntrySecondaryIconActivatable :: (MonadIO m, IsEntry o) => o -> m Bool
getEntrySecondaryIconActivatable :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntrySecondaryIconActivatable 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
"secondary-icon-activatable"

-- | Set the value of the “@secondary-icon-activatable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #secondaryIconActivatable 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntrySecondaryIconActivatable :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntrySecondaryIconActivatable :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntrySecondaryIconActivatable 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
"secondary-icon-activatable" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@secondary-icon-activatable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntrySecondaryIconActivatable :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntrySecondaryIconActivatable :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntrySecondaryIconActivatable 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
"secondary-icon-activatable" Bool
val

#if defined(ENABLE_OVERLOADING)
data EntrySecondaryIconActivatablePropertyInfo
instance AttrInfo EntrySecondaryIconActivatablePropertyInfo where
    type AttrAllowedOps EntrySecondaryIconActivatablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntrySecondaryIconActivatablePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntrySecondaryIconActivatablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntrySecondaryIconActivatablePropertyInfo = (~) Bool
    type AttrTransferType EntrySecondaryIconActivatablePropertyInfo = Bool
    type AttrGetType EntrySecondaryIconActivatablePropertyInfo = Bool
    type AttrLabel EntrySecondaryIconActivatablePropertyInfo = "secondary-icon-activatable"
    type AttrOrigin EntrySecondaryIconActivatablePropertyInfo = Entry
    attrGet = getEntrySecondaryIconActivatable
    attrSet = setEntrySecondaryIconActivatable
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntrySecondaryIconActivatable
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.secondaryIconActivatable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:secondaryIconActivatable"
        })
#endif

-- VVV Prop "secondary-icon-gicon"
   -- Type: TInterface (Name {namespace = "Gio", name = "Icon"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@secondary-icon-gicon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #secondaryIconGicon 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntrySecondaryIconGicon :: (MonadIO m, IsEntry o, Gio.Icon.IsIcon a) => o -> a -> m ()
setEntrySecondaryIconGicon :: forall (m :: * -> *) o a.
(MonadIO m, IsEntry o, IsIcon a) =>
o -> a -> m ()
setEntrySecondaryIconGicon 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
"secondary-icon-gicon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@secondary-icon-gicon@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntrySecondaryIconGicon :: (IsEntry o, MIO.MonadIO m, Gio.Icon.IsIcon a) => a -> m (GValueConstruct o)
constructEntrySecondaryIconGicon :: forall o (m :: * -> *) a.
(IsEntry o, MonadIO m, IsIcon a) =>
a -> m (GValueConstruct o)
constructEntrySecondaryIconGicon 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
"secondary-icon-gicon" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@secondary-icon-gicon@” 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' #secondaryIconGicon
-- @
clearEntrySecondaryIconGicon :: (MonadIO m, IsEntry o) => o -> m ()
clearEntrySecondaryIconGicon :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntrySecondaryIconGicon 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 Icon -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"secondary-icon-gicon" (Maybe Icon
forall a. Maybe a
Nothing :: Maybe Gio.Icon.Icon)

#if defined(ENABLE_OVERLOADING)
data EntrySecondaryIconGiconPropertyInfo
instance AttrInfo EntrySecondaryIconGiconPropertyInfo where
    type AttrAllowedOps EntrySecondaryIconGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntrySecondaryIconGiconPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntrySecondaryIconGiconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferTypeConstraint EntrySecondaryIconGiconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferType EntrySecondaryIconGiconPropertyInfo = Gio.Icon.Icon
    type AttrGetType EntrySecondaryIconGiconPropertyInfo = (Maybe Gio.Icon.Icon)
    type AttrLabel EntrySecondaryIconGiconPropertyInfo = "secondary-icon-gicon"
    type AttrOrigin EntrySecondaryIconGiconPropertyInfo = Entry
    attrGet = getEntrySecondaryIconGicon
    attrSet = setEntrySecondaryIconGicon
    attrTransfer _ v = do
        unsafeCastTo Gio.Icon.Icon v
    attrConstruct = constructEntrySecondaryIconGicon
    attrClear = clearEntrySecondaryIconGicon
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.secondaryIconGicon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:secondaryIconGicon"
        })
#endif

-- VVV Prop "secondary-icon-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@secondary-icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #secondaryIconName
-- @
getEntrySecondaryIconName :: (MonadIO m, IsEntry o) => o -> m (Maybe T.Text)
getEntrySecondaryIconName :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe Text)
getEntrySecondaryIconName 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
"secondary-icon-name"

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

-- | Construct a t'GValueConstruct' with valid value for the “@secondary-icon-name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntrySecondaryIconName :: (IsEntry o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEntrySecondaryIconName :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEntrySecondaryIconName 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
"secondary-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@secondary-icon-name@” 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' #secondaryIconName
-- @
clearEntrySecondaryIconName :: (MonadIO m, IsEntry o) => o -> m ()
clearEntrySecondaryIconName :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntrySecondaryIconName 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
"secondary-icon-name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data EntrySecondaryIconNamePropertyInfo
instance AttrInfo EntrySecondaryIconNamePropertyInfo where
    type AttrAllowedOps EntrySecondaryIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntrySecondaryIconNamePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntrySecondaryIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EntrySecondaryIconNamePropertyInfo = (~) T.Text
    type AttrTransferType EntrySecondaryIconNamePropertyInfo = T.Text
    type AttrGetType EntrySecondaryIconNamePropertyInfo = (Maybe T.Text)
    type AttrLabel EntrySecondaryIconNamePropertyInfo = "secondary-icon-name"
    type AttrOrigin EntrySecondaryIconNamePropertyInfo = Entry
    attrGet = getEntrySecondaryIconName
    attrSet = setEntrySecondaryIconName
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntrySecondaryIconName
    attrClear = clearEntrySecondaryIconName
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.secondaryIconName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:secondaryIconName"
        })
#endif

-- VVV Prop "secondary-icon-paintable"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Paintable"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@secondary-icon-paintable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #secondaryIconPaintable
-- @
getEntrySecondaryIconPaintable :: (MonadIO m, IsEntry o) => o -> m (Maybe Gdk.Paintable.Paintable)
getEntrySecondaryIconPaintable :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe Paintable)
getEntrySecondaryIconPaintable o
obj = IO (Maybe Paintable) -> m (Maybe Paintable)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Paintable) -> m (Maybe Paintable))
-> IO (Maybe Paintable) -> m (Maybe Paintable)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr Paintable -> Paintable)
-> IO (Maybe Paintable)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"secondary-icon-paintable" ManagedPtr Paintable -> Paintable
Gdk.Paintable.Paintable

-- | Set the value of the “@secondary-icon-paintable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #secondaryIconPaintable 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntrySecondaryIconPaintable :: (MonadIO m, IsEntry o, Gdk.Paintable.IsPaintable a) => o -> a -> m ()
setEntrySecondaryIconPaintable :: forall (m :: * -> *) o a.
(MonadIO m, IsEntry o, IsPaintable a) =>
o -> a -> m ()
setEntrySecondaryIconPaintable 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
"secondary-icon-paintable" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@secondary-icon-paintable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntrySecondaryIconPaintable :: (IsEntry o, MIO.MonadIO m, Gdk.Paintable.IsPaintable a) => a -> m (GValueConstruct o)
constructEntrySecondaryIconPaintable :: forall o (m :: * -> *) a.
(IsEntry o, MonadIO m, IsPaintable a) =>
a -> m (GValueConstruct o)
constructEntrySecondaryIconPaintable 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
"secondary-icon-paintable" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@secondary-icon-paintable@” 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' #secondaryIconPaintable
-- @
clearEntrySecondaryIconPaintable :: (MonadIO m, IsEntry o) => o -> m ()
clearEntrySecondaryIconPaintable :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntrySecondaryIconPaintable 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 Paintable -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"secondary-icon-paintable" (Maybe Paintable
forall a. Maybe a
Nothing :: Maybe Gdk.Paintable.Paintable)

#if defined(ENABLE_OVERLOADING)
data EntrySecondaryIconPaintablePropertyInfo
instance AttrInfo EntrySecondaryIconPaintablePropertyInfo where
    type AttrAllowedOps EntrySecondaryIconPaintablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntrySecondaryIconPaintablePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntrySecondaryIconPaintablePropertyInfo = Gdk.Paintable.IsPaintable
    type AttrTransferTypeConstraint EntrySecondaryIconPaintablePropertyInfo = Gdk.Paintable.IsPaintable
    type AttrTransferType EntrySecondaryIconPaintablePropertyInfo = Gdk.Paintable.Paintable
    type AttrGetType EntrySecondaryIconPaintablePropertyInfo = (Maybe Gdk.Paintable.Paintable)
    type AttrLabel EntrySecondaryIconPaintablePropertyInfo = "secondary-icon-paintable"
    type AttrOrigin EntrySecondaryIconPaintablePropertyInfo = Entry
    attrGet = getEntrySecondaryIconPaintable
    attrSet = setEntrySecondaryIconPaintable
    attrTransfer _ v = do
        unsafeCastTo Gdk.Paintable.Paintable v
    attrConstruct = constructEntrySecondaryIconPaintable
    attrClear = clearEntrySecondaryIconPaintable
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.secondaryIconPaintable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:secondaryIconPaintable"
        })
#endif

-- VVV Prop "secondary-icon-sensitive"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@secondary-icon-sensitive@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #secondaryIconSensitive
-- @
getEntrySecondaryIconSensitive :: (MonadIO m, IsEntry o) => o -> m Bool
getEntrySecondaryIconSensitive :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntrySecondaryIconSensitive 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
"secondary-icon-sensitive"

-- | Set the value of the “@secondary-icon-sensitive@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #secondaryIconSensitive 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntrySecondaryIconSensitive :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntrySecondaryIconSensitive :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntrySecondaryIconSensitive 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
"secondary-icon-sensitive" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@secondary-icon-sensitive@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntrySecondaryIconSensitive :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntrySecondaryIconSensitive :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntrySecondaryIconSensitive 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
"secondary-icon-sensitive" Bool
val

#if defined(ENABLE_OVERLOADING)
data EntrySecondaryIconSensitivePropertyInfo
instance AttrInfo EntrySecondaryIconSensitivePropertyInfo where
    type AttrAllowedOps EntrySecondaryIconSensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntrySecondaryIconSensitivePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntrySecondaryIconSensitivePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntrySecondaryIconSensitivePropertyInfo = (~) Bool
    type AttrTransferType EntrySecondaryIconSensitivePropertyInfo = Bool
    type AttrGetType EntrySecondaryIconSensitivePropertyInfo = Bool
    type AttrLabel EntrySecondaryIconSensitivePropertyInfo = "secondary-icon-sensitive"
    type AttrOrigin EntrySecondaryIconSensitivePropertyInfo = Entry
    attrGet = getEntrySecondaryIconSensitive
    attrSet = setEntrySecondaryIconSensitive
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntrySecondaryIconSensitive
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.secondaryIconSensitive"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:secondaryIconSensitive"
        })
#endif

-- VVV Prop "secondary-icon-storage-type"
   -- Type: TInterface (Name {namespace = "Gtk", name = "ImageType"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@secondary-icon-storage-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #secondaryIconStorageType
-- @
getEntrySecondaryIconStorageType :: (MonadIO m, IsEntry o) => o -> m Gtk.Enums.ImageType
getEntrySecondaryIconStorageType :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ImageType
getEntrySecondaryIconStorageType o
obj = IO ImageType -> m ImageType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ImageType -> m ImageType) -> IO ImageType -> m ImageType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ImageType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"secondary-icon-storage-type"

#if defined(ENABLE_OVERLOADING)
data EntrySecondaryIconStorageTypePropertyInfo
instance AttrInfo EntrySecondaryIconStorageTypePropertyInfo where
    type AttrAllowedOps EntrySecondaryIconStorageTypePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint EntrySecondaryIconStorageTypePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntrySecondaryIconStorageTypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint EntrySecondaryIconStorageTypePropertyInfo = (~) ()
    type AttrTransferType EntrySecondaryIconStorageTypePropertyInfo = ()
    type AttrGetType EntrySecondaryIconStorageTypePropertyInfo = Gtk.Enums.ImageType
    type AttrLabel EntrySecondaryIconStorageTypePropertyInfo = "secondary-icon-storage-type"
    type AttrOrigin EntrySecondaryIconStorageTypePropertyInfo = Entry
    attrGet = getEntrySecondaryIconStorageType
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.secondaryIconStorageType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:secondaryIconStorageType"
        })
#endif

-- VVV Prop "secondary-icon-tooltip-markup"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@secondary-icon-tooltip-markup@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #secondaryIconTooltipMarkup
-- @
getEntrySecondaryIconTooltipMarkup :: (MonadIO m, IsEntry o) => o -> m (Maybe T.Text)
getEntrySecondaryIconTooltipMarkup :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe Text)
getEntrySecondaryIconTooltipMarkup 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
"secondary-icon-tooltip-markup"

-- | Set the value of the “@secondary-icon-tooltip-markup@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #secondaryIconTooltipMarkup 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntrySecondaryIconTooltipMarkup :: (MonadIO m, IsEntry o) => o -> T.Text -> m ()
setEntrySecondaryIconTooltipMarkup :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Text -> m ()
setEntrySecondaryIconTooltipMarkup 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
"secondary-icon-tooltip-markup" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a t'GValueConstruct' with valid value for the “@secondary-icon-tooltip-markup@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntrySecondaryIconTooltipMarkup :: (IsEntry o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEntrySecondaryIconTooltipMarkup :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEntrySecondaryIconTooltipMarkup 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
"secondary-icon-tooltip-markup" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@secondary-icon-tooltip-markup@” 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' #secondaryIconTooltipMarkup
-- @
clearEntrySecondaryIconTooltipMarkup :: (MonadIO m, IsEntry o) => o -> m ()
clearEntrySecondaryIconTooltipMarkup :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntrySecondaryIconTooltipMarkup 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
"secondary-icon-tooltip-markup" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data EntrySecondaryIconTooltipMarkupPropertyInfo
instance AttrInfo EntrySecondaryIconTooltipMarkupPropertyInfo where
    type AttrAllowedOps EntrySecondaryIconTooltipMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntrySecondaryIconTooltipMarkupPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntrySecondaryIconTooltipMarkupPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EntrySecondaryIconTooltipMarkupPropertyInfo = (~) T.Text
    type AttrTransferType EntrySecondaryIconTooltipMarkupPropertyInfo = T.Text
    type AttrGetType EntrySecondaryIconTooltipMarkupPropertyInfo = (Maybe T.Text)
    type AttrLabel EntrySecondaryIconTooltipMarkupPropertyInfo = "secondary-icon-tooltip-markup"
    type AttrOrigin EntrySecondaryIconTooltipMarkupPropertyInfo = Entry
    attrGet = getEntrySecondaryIconTooltipMarkup
    attrSet = setEntrySecondaryIconTooltipMarkup
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntrySecondaryIconTooltipMarkup
    attrClear = clearEntrySecondaryIconTooltipMarkup
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.secondaryIconTooltipMarkup"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:secondaryIconTooltipMarkup"
        })
#endif

-- VVV Prop "secondary-icon-tooltip-text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@secondary-icon-tooltip-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #secondaryIconTooltipText
-- @
getEntrySecondaryIconTooltipText :: (MonadIO m, IsEntry o) => o -> m (Maybe T.Text)
getEntrySecondaryIconTooltipText :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe Text)
getEntrySecondaryIconTooltipText 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
"secondary-icon-tooltip-text"

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

-- | Construct a t'GValueConstruct' with valid value for the “@secondary-icon-tooltip-text@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntrySecondaryIconTooltipText :: (IsEntry o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEntrySecondaryIconTooltipText :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEntrySecondaryIconTooltipText 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
"secondary-icon-tooltip-text" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@secondary-icon-tooltip-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' #secondaryIconTooltipText
-- @
clearEntrySecondaryIconTooltipText :: (MonadIO m, IsEntry o) => o -> m ()
clearEntrySecondaryIconTooltipText :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntrySecondaryIconTooltipText 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
"secondary-icon-tooltip-text" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data EntrySecondaryIconTooltipTextPropertyInfo
instance AttrInfo EntrySecondaryIconTooltipTextPropertyInfo where
    type AttrAllowedOps EntrySecondaryIconTooltipTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntrySecondaryIconTooltipTextPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntrySecondaryIconTooltipTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EntrySecondaryIconTooltipTextPropertyInfo = (~) T.Text
    type AttrTransferType EntrySecondaryIconTooltipTextPropertyInfo = T.Text
    type AttrGetType EntrySecondaryIconTooltipTextPropertyInfo = (Maybe T.Text)
    type AttrLabel EntrySecondaryIconTooltipTextPropertyInfo = "secondary-icon-tooltip-text"
    type AttrOrigin EntrySecondaryIconTooltipTextPropertyInfo = Entry
    attrGet = getEntrySecondaryIconTooltipText
    attrSet = setEntrySecondaryIconTooltipText
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntrySecondaryIconTooltipText
    attrClear = clearEntrySecondaryIconTooltipText
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.secondaryIconTooltipText"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:secondaryIconTooltipText"
        })
#endif

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

-- | Get the value of the “@show-emoji-icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #showEmojiIcon
-- @
getEntryShowEmojiIcon :: (MonadIO m, IsEntry o) => o -> m Bool
getEntryShowEmojiIcon :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntryShowEmojiIcon 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
"show-emoji-icon"

-- | Set the value of the “@show-emoji-icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' entry [ #showEmojiIcon 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryShowEmojiIcon :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryShowEmojiIcon :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryShowEmojiIcon 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
"show-emoji-icon" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@show-emoji-icon@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEntryShowEmojiIcon :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntryShowEmojiIcon :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntryShowEmojiIcon 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
"show-emoji-icon" Bool
val

#if defined(ENABLE_OVERLOADING)
data EntryShowEmojiIconPropertyInfo
instance AttrInfo EntryShowEmojiIconPropertyInfo where
    type AttrAllowedOps EntryShowEmojiIconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryShowEmojiIconPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryShowEmojiIconPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryShowEmojiIconPropertyInfo = (~) Bool
    type AttrTransferType EntryShowEmojiIconPropertyInfo = Bool
    type AttrGetType EntryShowEmojiIconPropertyInfo = Bool
    type AttrLabel EntryShowEmojiIconPropertyInfo = "show-emoji-icon"
    type AttrOrigin EntryShowEmojiIconPropertyInfo = Entry
    attrGet = getEntryShowEmojiIcon
    attrSet = setEntryShowEmojiIcon
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryShowEmojiIcon
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.showEmojiIcon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:showEmojiIcon"
        })
#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' entry #tabs
-- @
getEntryTabs :: (MonadIO m, IsEntry o) => o -> m (Maybe Pango.TabArray.TabArray)
getEntryTabs :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m (Maybe TabArray)
getEntryTabs 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' entry [ #tabs 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryTabs :: (MonadIO m, IsEntry o) => o -> Pango.TabArray.TabArray -> m ()
setEntryTabs :: forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> TabArray -> m ()
setEntryTabs 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`.
constructEntryTabs :: (IsEntry o, MIO.MonadIO m) => Pango.TabArray.TabArray -> m (GValueConstruct o)
constructEntryTabs :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
TabArray -> m (GValueConstruct o)
constructEntryTabs 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
-- @
clearEntryTabs :: (MonadIO m, IsEntry o) => o -> m ()
clearEntryTabs :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m ()
clearEntryTabs 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 EntryTabsPropertyInfo
instance AttrInfo EntryTabsPropertyInfo where
    type AttrAllowedOps EntryTabsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EntryTabsPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryTabsPropertyInfo = (~) Pango.TabArray.TabArray
    type AttrTransferTypeConstraint EntryTabsPropertyInfo = (~) Pango.TabArray.TabArray
    type AttrTransferType EntryTabsPropertyInfo = Pango.TabArray.TabArray
    type AttrGetType EntryTabsPropertyInfo = (Maybe Pango.TabArray.TabArray)
    type AttrLabel EntryTabsPropertyInfo = "tabs"
    type AttrOrigin EntryTabsPropertyInfo = Entry
    attrGet = getEntryTabs
    attrSet = setEntryTabs
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryTabs
    attrClear = clearEntryTabs
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.tabs"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:tabs"
        })
#endif

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

-- | Get the value of the “@text-length@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #textLength
-- @
getEntryTextLength :: (MonadIO m, IsEntry o) => o -> m Word32
getEntryTextLength :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Word32
getEntryTextLength 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
"text-length"

#if defined(ENABLE_OVERLOADING)
data EntryTextLengthPropertyInfo
instance AttrInfo EntryTextLengthPropertyInfo where
    type AttrAllowedOps EntryTextLengthPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint EntryTextLengthPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryTextLengthPropertyInfo = (~) ()
    type AttrTransferTypeConstraint EntryTextLengthPropertyInfo = (~) ()
    type AttrTransferType EntryTextLengthPropertyInfo = ()
    type AttrGetType EntryTextLengthPropertyInfo = Word32
    type AttrLabel EntryTextLengthPropertyInfo = "text-length"
    type AttrOrigin EntryTextLengthPropertyInfo = Entry
    attrGet = getEntryTextLength
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.textLength"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:textLength"
        })
#endif

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

-- | Get the value of the “@truncate-multiline@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' entry #truncateMultiline
-- @
getEntryTruncateMultiline :: (MonadIO m, IsEntry o) => o -> m Bool
getEntryTruncateMultiline :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntryTruncateMultiline 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' entry [ #truncateMultiline 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryTruncateMultiline :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryTruncateMultiline :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryTruncateMultiline 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`.
constructEntryTruncateMultiline :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntryTruncateMultiline :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntryTruncateMultiline 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 EntryTruncateMultilinePropertyInfo
instance AttrInfo EntryTruncateMultilinePropertyInfo where
    type AttrAllowedOps EntryTruncateMultilinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryTruncateMultilinePropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryTruncateMultilinePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryTruncateMultilinePropertyInfo = (~) Bool
    type AttrTransferType EntryTruncateMultilinePropertyInfo = Bool
    type AttrGetType EntryTruncateMultilinePropertyInfo = Bool
    type AttrLabel EntryTruncateMultilinePropertyInfo = "truncate-multiline"
    type AttrOrigin EntryTruncateMultilinePropertyInfo = Entry
    attrGet = getEntryTruncateMultiline
    attrSet = setEntryTruncateMultiline
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryTruncateMultiline
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.truncateMultiline"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.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' entry #visibility
-- @
getEntryVisibility :: (MonadIO m, IsEntry o) => o -> m Bool
getEntryVisibility :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> m Bool
getEntryVisibility 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' entry [ #visibility 'Data.GI.Base.Attributes.:=' value ]
-- @
setEntryVisibility :: (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryVisibility :: forall (m :: * -> *) o. (MonadIO m, IsEntry o) => o -> Bool -> m ()
setEntryVisibility 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`.
constructEntryVisibility :: (IsEntry o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructEntryVisibility :: forall o (m :: * -> *).
(IsEntry o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructEntryVisibility 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 EntryVisibilityPropertyInfo
instance AttrInfo EntryVisibilityPropertyInfo where
    type AttrAllowedOps EntryVisibilityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryVisibilityPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryVisibilityPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryVisibilityPropertyInfo = (~) Bool
    type AttrTransferType EntryVisibilityPropertyInfo = Bool
    type AttrGetType EntryVisibilityPropertyInfo = Bool
    type AttrLabel EntryVisibilityPropertyInfo = "visibility"
    type AttrOrigin EntryVisibilityPropertyInfo = Entry
    attrGet = getEntryVisibility
    attrSet = setEntryVisibility
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryVisibility
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Entry.visibility"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-Entry.html#g:attr:visibility"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Entry
type instance O.AttributeList Entry = EntryAttributeList
type EntryAttributeList = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("activatesDefault", EntryActivatesDefaultPropertyInfo), '("attributes", EntryAttributesPropertyInfo), '("buffer", EntryBufferPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("completion", EntryCompletionPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("cursorPosition", Gtk.Editable.EditableCursorPositionPropertyInfo), '("editable", Gtk.Editable.EditableEditablePropertyInfo), '("editingCanceled", Gtk.CellEditable.CellEditableEditingCanceledPropertyInfo), '("enableEmojiCompletion", EntryEnableEmojiCompletionPropertyInfo), '("enableUndo", Gtk.Editable.EditableEnableUndoPropertyInfo), '("extraMenu", EntryExtraMenuPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasFrame", EntryHasFramePropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("imModule", EntryImModulePropertyInfo), '("inputHints", EntryInputHintsPropertyInfo), '("inputPurpose", EntryInputPurposePropertyInfo), '("invisibleChar", EntryInvisibleCharPropertyInfo), '("invisibleCharSet", EntryInvisibleCharSetPropertyInfo), '("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", EntryMaxLengthPropertyInfo), '("maxWidthChars", Gtk.Editable.EditableMaxWidthCharsPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("overwriteMode", EntryOverwriteModePropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("placeholderText", EntryPlaceholderTextPropertyInfo), '("primaryIconActivatable", EntryPrimaryIconActivatablePropertyInfo), '("primaryIconGicon", EntryPrimaryIconGiconPropertyInfo), '("primaryIconName", EntryPrimaryIconNamePropertyInfo), '("primaryIconPaintable", EntryPrimaryIconPaintablePropertyInfo), '("primaryIconSensitive", EntryPrimaryIconSensitivePropertyInfo), '("primaryIconStorageType", EntryPrimaryIconStorageTypePropertyInfo), '("primaryIconTooltipMarkup", EntryPrimaryIconTooltipMarkupPropertyInfo), '("primaryIconTooltipText", EntryPrimaryIconTooltipTextPropertyInfo), '("progressFraction", EntryProgressFractionPropertyInfo), '("progressPulseStep", EntryProgressPulseStepPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("scrollOffset", EntryScrollOffsetPropertyInfo), '("secondaryIconActivatable", EntrySecondaryIconActivatablePropertyInfo), '("secondaryIconGicon", EntrySecondaryIconGiconPropertyInfo), '("secondaryIconName", EntrySecondaryIconNamePropertyInfo), '("secondaryIconPaintable", EntrySecondaryIconPaintablePropertyInfo), '("secondaryIconSensitive", EntrySecondaryIconSensitivePropertyInfo), '("secondaryIconStorageType", EntrySecondaryIconStorageTypePropertyInfo), '("secondaryIconTooltipMarkup", EntrySecondaryIconTooltipMarkupPropertyInfo), '("secondaryIconTooltipText", EntrySecondaryIconTooltipTextPropertyInfo), '("selectionBound", Gtk.Editable.EditableSelectionBoundPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("showEmojiIcon", EntryShowEmojiIconPropertyInfo), '("tabs", EntryTabsPropertyInfo), '("text", Gtk.Editable.EditableTextPropertyInfo), '("textLength", EntryTextLengthPropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("truncateMultiline", EntryTruncateMultilinePropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visibility", EntryVisibilityPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthChars", Gtk.Editable.EditableWidthCharsPropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo), '("xalign", Gtk.Editable.EditableXalignPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

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

entryAttributes :: AttrLabelProxy "attributes"
entryAttributes = AttrLabelProxy

entryBuffer :: AttrLabelProxy "buffer"
entryBuffer = AttrLabelProxy

entryCompletion :: AttrLabelProxy "completion"
entryCompletion = AttrLabelProxy

entryEnableEmojiCompletion :: AttrLabelProxy "enableEmojiCompletion"
entryEnableEmojiCompletion = AttrLabelProxy

entryExtraMenu :: AttrLabelProxy "extraMenu"
entryExtraMenu = AttrLabelProxy

entryHasFrame :: AttrLabelProxy "hasFrame"
entryHasFrame = AttrLabelProxy

entryImModule :: AttrLabelProxy "imModule"
entryImModule = AttrLabelProxy

entryInputHints :: AttrLabelProxy "inputHints"
entryInputHints = AttrLabelProxy

entryInputPurpose :: AttrLabelProxy "inputPurpose"
entryInputPurpose = AttrLabelProxy

entryInvisibleChar :: AttrLabelProxy "invisibleChar"
entryInvisibleChar = AttrLabelProxy

entryInvisibleCharSet :: AttrLabelProxy "invisibleCharSet"
entryInvisibleCharSet = AttrLabelProxy

entryMaxLength :: AttrLabelProxy "maxLength"
entryMaxLength = AttrLabelProxy

entryOverwriteMode :: AttrLabelProxy "overwriteMode"
entryOverwriteMode = AttrLabelProxy

entryPlaceholderText :: AttrLabelProxy "placeholderText"
entryPlaceholderText = AttrLabelProxy

entryPrimaryIconActivatable :: AttrLabelProxy "primaryIconActivatable"
entryPrimaryIconActivatable = AttrLabelProxy

entryPrimaryIconGicon :: AttrLabelProxy "primaryIconGicon"
entryPrimaryIconGicon = AttrLabelProxy

entryPrimaryIconName :: AttrLabelProxy "primaryIconName"
entryPrimaryIconName = AttrLabelProxy

entryPrimaryIconPaintable :: AttrLabelProxy "primaryIconPaintable"
entryPrimaryIconPaintable = AttrLabelProxy

entryPrimaryIconSensitive :: AttrLabelProxy "primaryIconSensitive"
entryPrimaryIconSensitive = AttrLabelProxy

entryPrimaryIconStorageType :: AttrLabelProxy "primaryIconStorageType"
entryPrimaryIconStorageType = AttrLabelProxy

entryPrimaryIconTooltipMarkup :: AttrLabelProxy "primaryIconTooltipMarkup"
entryPrimaryIconTooltipMarkup = AttrLabelProxy

entryPrimaryIconTooltipText :: AttrLabelProxy "primaryIconTooltipText"
entryPrimaryIconTooltipText = AttrLabelProxy

entryProgressFraction :: AttrLabelProxy "progressFraction"
entryProgressFraction = AttrLabelProxy

entryProgressPulseStep :: AttrLabelProxy "progressPulseStep"
entryProgressPulseStep = AttrLabelProxy

entryScrollOffset :: AttrLabelProxy "scrollOffset"
entryScrollOffset = AttrLabelProxy

entrySecondaryIconActivatable :: AttrLabelProxy "secondaryIconActivatable"
entrySecondaryIconActivatable = AttrLabelProxy

entrySecondaryIconGicon :: AttrLabelProxy "secondaryIconGicon"
entrySecondaryIconGicon = AttrLabelProxy

entrySecondaryIconName :: AttrLabelProxy "secondaryIconName"
entrySecondaryIconName = AttrLabelProxy

entrySecondaryIconPaintable :: AttrLabelProxy "secondaryIconPaintable"
entrySecondaryIconPaintable = AttrLabelProxy

entrySecondaryIconSensitive :: AttrLabelProxy "secondaryIconSensitive"
entrySecondaryIconSensitive = AttrLabelProxy

entrySecondaryIconStorageType :: AttrLabelProxy "secondaryIconStorageType"
entrySecondaryIconStorageType = AttrLabelProxy

entrySecondaryIconTooltipMarkup :: AttrLabelProxy "secondaryIconTooltipMarkup"
entrySecondaryIconTooltipMarkup = AttrLabelProxy

entrySecondaryIconTooltipText :: AttrLabelProxy "secondaryIconTooltipText"
entrySecondaryIconTooltipText = AttrLabelProxy

entryShowEmojiIcon :: AttrLabelProxy "showEmojiIcon"
entryShowEmojiIcon = AttrLabelProxy

entryTabs :: AttrLabelProxy "tabs"
entryTabs = AttrLabelProxy

entryTextLength :: AttrLabelProxy "textLength"
entryTextLength = AttrLabelProxy

entryTruncateMultiline :: AttrLabelProxy "truncateMultiline"
entryTruncateMultiline = AttrLabelProxy

entryVisibility :: AttrLabelProxy "visibility"
entryVisibility = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Entry = EntrySignalList
type EntrySignalList = ('[ '("activate", EntryActivateSignalInfo), '("changed", Gtk.Editable.EditableChangedSignalInfo), '("deleteText", Gtk.Editable.EditableDeleteTextSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("editingDone", Gtk.CellEditable.CellEditableEditingDoneSignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("iconPress", EntryIconPressSignalInfo), '("iconRelease", EntryIconReleaseSignalInfo), '("insertText", Gtk.Editable.EditableInsertTextSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("removeWidget", Gtk.CellEditable.CellEditableRemoveWidgetSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "gtk_entry_new" gtk_entry_new :: 
    IO (Ptr Entry)

-- | Creates a new entry.
entryNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Entry
    -- ^ __Returns:__ a new @GtkEntry@.
entryNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Entry
entryNew  = IO Entry -> m Entry
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Entry -> m Entry) -> IO Entry -> m Entry
forall a b. (a -> b) -> a -> b
$ do
    result <- IO (Ptr Entry)
gtk_entry_new
    checkUnexpectedReturnNULL "entryNew" result
    result' <- (newObject Entry) result
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Creates a new entry with the specified text buffer.
entryNewWithBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.EntryBuffer.IsEntryBuffer a) =>
    a
    -- ^ /@buffer@/: The buffer to use for the new @GtkEntry@.
    -> m Entry
    -- ^ __Returns:__ a new @GtkEntry@
entryNewWithBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntryBuffer a) =>
a -> m Entry
entryNewWithBuffer a
buffer = IO Entry -> m Entry
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Entry -> m Entry) -> IO Entry -> m Entry
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_entry_new_with_buffer buffer'
    checkUnexpectedReturnNULL "entryNewWithBuffer" result
    result' <- (newObject Entry) result
    touchManagedPtr buffer
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Entry::get_activates_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_activates_default" gtk_entry_get_activates_default :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CInt

-- | Retrieves the value set by 'GI.Gtk.Objects.Entry.entrySetActivatesDefault'.
entryGetActivatesDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the entry will activate the default widget
entryGetActivatesDefault :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Bool
entryGetActivatesDefault a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_activates_default entry'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetActivatesDefaultMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetActivatesDefaultMethodInfo a signature where
    overloadedMethod = entryGetActivatesDefault

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


#endif

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

foreign import ccall "gtk_entry_get_alignment" gtk_entry_get_alignment :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CFloat

-- | Gets the value set by 'GI.Gtk.Objects.Entry.entrySetAlignment'.
-- 
-- See also: [Editable:xalign]("GI.Gtk.Interfaces.Editable#g:attr:xalign")
entryGetAlignment ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Float
    -- ^ __Returns:__ the alignment
entryGetAlignment :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Float
entryGetAlignment a
entry = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_alignment entry'
    let result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetAlignmentMethodInfo
instance (signature ~ (m Float), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetAlignmentMethodInfo a signature where
    overloadedMethod = entryGetAlignment

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


#endif

-- method Entry::get_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_attributes" gtk_entry_get_attributes :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO (Ptr Pango.AttrList.AttrList)

-- | Gets the attribute list of the @GtkEntry@.
-- 
-- See 'GI.Gtk.Objects.Entry.entrySetAttributes'.
entryGetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m (Maybe Pango.AttrList.AttrList)
    -- ^ __Returns:__ the attribute list
entryGetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m (Maybe AttrList)
entryGetAttributes a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_attributes entry'
    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 entry
    return maybeResult

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

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


#endif

-- method Entry::get_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_buffer" gtk_entry_get_buffer :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO (Ptr Gtk.EntryBuffer.EntryBuffer)

-- | Get the @GtkEntryBuffer@ object which holds the text for
-- this widget.
entryGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Gtk.EntryBuffer.EntryBuffer
    -- ^ __Returns:__ A @GtkEntryBuffer@ object.
entryGetBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m EntryBuffer
entryGetBuffer a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_buffer entry'
    checkUnexpectedReturnNULL "entryGetBuffer" result
    result' <- (newObject Gtk.EntryBuffer.EntryBuffer) result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetBufferMethodInfo
instance (signature ~ (m Gtk.EntryBuffer.EntryBuffer), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetBufferMethodInfo a signature where
    overloadedMethod = entryGetBuffer

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


#endif

-- method Entry::get_completion
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "EntryCompletion" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_get_completion" gtk_entry_get_completion :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO (Ptr Gtk.EntryCompletion.EntryCompletion)

{-# DEPRECATED entryGetCompletion ["(Since version 4.10)","GtkEntryCompletion will be removed in GTK 5."] #-}
-- | Returns the auxiliary completion object currently
-- in use by /@entry@/.
entryGetCompletion ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A @GtkEntry@
    -> m (Maybe Gtk.EntryCompletion.EntryCompletion)
    -- ^ __Returns:__ The auxiliary
    --   completion object currently in use by /@entry@/
entryGetCompletion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m (Maybe EntryCompletion)
entryGetCompletion a
entry = IO (Maybe EntryCompletion) -> m (Maybe EntryCompletion)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe EntryCompletion) -> m (Maybe EntryCompletion))
-> IO (Maybe EntryCompletion) -> m (Maybe EntryCompletion)
forall a b. (a -> b) -> a -> b
$ do
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_completion entry'
    maybeResult <- convertIfNonNull result $ \Ptr EntryCompletion
result' -> do
        result'' <- ((ManagedPtr EntryCompletion -> EntryCompletion)
-> Ptr EntryCompletion -> IO EntryCompletion
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr EntryCompletion -> EntryCompletion
Gtk.EntryCompletion.EntryCompletion) Ptr EntryCompletion
result'
        return result''
    touchManagedPtr entry
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetCompletionMethodInfo
instance (signature ~ (m (Maybe Gtk.EntryCompletion.EntryCompletion)), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetCompletionMethodInfo a signature where
    overloadedMethod = entryGetCompletion

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


#endif

-- method Entry::get_current_icon_drag_source
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_current_icon_drag_source" gtk_entry_get_current_icon_drag_source :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO Int32

-- | Returns the index of the icon which is the source of the
-- current  DND operation, or -1.
entryGetCurrentIconDragSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Int32
    -- ^ __Returns:__ index of the icon which is the source of the
    --   current DND operation, or -1.
entryGetCurrentIconDragSource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Int32
entryGetCurrentIconDragSource a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_current_icon_drag_source entry'
    touchManagedPtr entry
    return result

#if defined(ENABLE_OVERLOADING)
data EntryGetCurrentIconDragSourceMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetCurrentIconDragSourceMethodInfo a signature where
    overloadedMethod = entryGetCurrentIconDragSource

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


#endif

-- method Entry::get_extra_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_extra_menu" gtk_entry_get_extra_menu :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO (Ptr Gio.MenuModel.MenuModel)

-- | Gets the menu model set with 'GI.Gtk.Objects.Entry.entrySetExtraMenu'.
entryGetExtraMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m (Maybe Gio.MenuModel.MenuModel)
    -- ^ __Returns:__ the menu model
entryGetExtraMenu :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m (Maybe MenuModel)
entryGetExtraMenu a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_extra_menu entry'
    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 entry
    return maybeResult

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

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


#endif

-- method Entry::get_has_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_has_frame" gtk_entry_get_has_frame :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CInt

-- | Gets the value set by 'GI.Gtk.Objects.Entry.entrySetHasFrame'.
entryGetHasFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Bool
    -- ^ __Returns:__ whether the entry has a beveled frame
entryGetHasFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Bool
entryGetHasFrame a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_has_frame entry'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetHasFrameMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetHasFrameMethodInfo a signature where
    overloadedMethod = entryGetHasFrame

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


#endif

-- method Entry::get_icon_activatable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon position" , 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_entry_get_icon_activatable" gtk_entry_get_icon_activatable :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    IO CInt

-- | Returns whether the icon is activatable.
entryGetIconActivatable ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the icon is activatable.
entryGetIconActivatable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> m Bool
entryGetIconActivatable a
entry EntryIconPosition
iconPos = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    result <- gtk_entry_get_icon_activatable entry' iconPos'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetIconActivatableMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m Bool), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetIconActivatableMethodInfo a signature where
    overloadedMethod = entryGetIconActivatable

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


#endif

-- method Entry::get_icon_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_area"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for the icon\8217s area"
--                 , 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_entry_get_icon_area" gtk_entry_get_icon_area :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    Ptr Gdk.Rectangle.Rectangle ->          -- icon_area : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    IO ()

-- | Gets the area where entry’s icon at /@iconPos@/ is drawn.
-- 
-- This function is useful when drawing something to the
-- entry in a draw callback.
-- 
-- If the entry is not realized or has no icon at the given
-- position, /@iconArea@/ is filled with zeros. Otherwise,
-- /@iconArea@/ will be filled with the icon\'s allocation,
-- relative to /@entry@/\'s allocation.
entryGetIconArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m (Gdk.Rectangle.Rectangle)
entryGetIconArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> m Rectangle
entryGetIconArea a
entry EntryIconPosition
iconPos = IO Rectangle -> m Rectangle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> m Rectangle) -> IO Rectangle -> m Rectangle
forall a b. (a -> b) -> a -> b
$ do
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    iconArea <- SP.callocBoxedBytes 16 :: IO (Ptr Gdk.Rectangle.Rectangle)
    gtk_entry_get_icon_area entry' iconPos' iconArea
    iconArea' <- (wrapBoxed Gdk.Rectangle.Rectangle) iconArea
    touchManagedPtr entry
    return iconArea'

#if defined(ENABLE_OVERLOADING)
data EntryGetIconAreaMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Gdk.Rectangle.Rectangle)), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetIconAreaMethodInfo a signature where
    overloadedMethod = entryGetIconArea

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


#endif

-- method Entry::get_icon_at_pos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the x coordinate of the position to find, relative to @entry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the y coordinate of the position to find, relative to @entry"
--                 , 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_entry_get_icon_at_pos" gtk_entry_get_icon_at_pos :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO Int32

-- | Finds the icon at the given position and return its index.
-- 
-- The position’s coordinates are relative to the /@entry@/’s
-- top left corner. If /@x@/, /@y@/ doesn’t lie inside an icon,
-- -1 is returned. This function is intended for use in a
-- [Widget::queryTooltip]("GI.Gtk.Objects.Widget#g:signal:queryTooltip") signal handler.
entryGetIconAtPos ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Int32
    -- ^ /@x@/: the x coordinate of the position to find, relative to /@entry@/
    -> Int32
    -- ^ /@y@/: the y coordinate of the position to find, relative to /@entry@/
    -> m Int32
    -- ^ __Returns:__ the index of the icon at the given position, or -1
entryGetIconAtPos :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Int32 -> Int32 -> m Int32
entryGetIconAtPos a
entry Int32
x Int32
y = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_icon_at_pos entry' x y
    touchManagedPtr entry
    return result

#if defined(ENABLE_OVERLOADING)
data EntryGetIconAtPosMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Int32), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetIconAtPosMethodInfo a signature where
    overloadedMethod = entryGetIconAtPos

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


#endif

-- method Entry::get_icon_gicon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Icon" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_get_icon_gicon" gtk_entry_get_icon_gicon :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    IO (Ptr Gio.Icon.Icon)

-- | Retrieves the @GIcon@ used for the icon.
-- 
-- 'P.Nothing' will be returned if there is no icon or if the icon was
-- set by some other method (e.g., by @GdkPaintable@ or icon name).
entryGetIconGicon ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m (Maybe Gio.Icon.Icon)
    -- ^ __Returns:__ A @GIcon@
entryGetIconGicon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> m (Maybe Icon)
entryGetIconGicon a
entry EntryIconPosition
iconPos = IO (Maybe Icon) -> m (Maybe Icon)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ do
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    result <- gtk_entry_get_icon_gicon entry' iconPos'
    maybeResult <- convertIfNonNull result $ \Ptr Icon
result' -> do
        result'' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result'
        return result''
    touchManagedPtr entry
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetIconGiconMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Maybe Gio.Icon.Icon)), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetIconGiconMethodInfo a signature where
    overloadedMethod = entryGetIconGicon

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


#endif

-- method Entry::get_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon position" , 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_entry_get_icon_name" gtk_entry_get_icon_name :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    IO CString

-- | Retrieves the icon name used for the icon.
-- 
-- 'P.Nothing' is returned if there is no icon or if the icon was set
-- by some other method (e.g., by @GdkPaintable@ or gicon).
entryGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m (Maybe T.Text)
    -- ^ __Returns:__ An icon name
entryGetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> m (Maybe Text)
entryGetIconName a
entry EntryIconPosition
iconPos = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    result <- gtk_entry_get_icon_name entry' iconPos'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr entry
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetIconNameMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Maybe T.Text)), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetIconNameMethodInfo a signature where
    overloadedMethod = entryGetIconName

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


#endif

-- method Entry::get_icon_paintable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Paintable" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_get_icon_paintable" gtk_entry_get_icon_paintable :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    IO (Ptr Gdk.Paintable.Paintable)

-- | Retrieves the @GdkPaintable@ used for the icon.
-- 
-- If no @GdkPaintable@ was used for the icon, 'P.Nothing' is returned.
entryGetIconPaintable ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m (Maybe Gdk.Paintable.Paintable)
    -- ^ __Returns:__ A @GdkPaintable@
    --   if no icon is set for this position or the icon set is not
    --   a @GdkPaintable@.
entryGetIconPaintable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> m (Maybe Paintable)
entryGetIconPaintable a
entry EntryIconPosition
iconPos = IO (Maybe Paintable) -> m (Maybe Paintable)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Paintable) -> m (Maybe Paintable))
-> IO (Maybe Paintable) -> m (Maybe Paintable)
forall a b. (a -> b) -> a -> b
$ do
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    result <- gtk_entry_get_icon_paintable entry' iconPos'
    maybeResult <- convertIfNonNull result $ \Ptr Paintable
result' -> do
        result'' <- ((ManagedPtr Paintable -> Paintable)
-> Ptr Paintable -> IO Paintable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Paintable -> Paintable
Gdk.Paintable.Paintable) Ptr Paintable
result'
        return result''
    touchManagedPtr entry
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetIconPaintableMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Maybe Gdk.Paintable.Paintable)), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetIconPaintableMethodInfo a signature where
    overloadedMethod = entryGetIconPaintable

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


#endif

-- method Entry::get_icon_sensitive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon position" , 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_entry_get_icon_sensitive" gtk_entry_get_icon_sensitive :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    IO CInt

-- | Returns whether the icon appears sensitive or insensitive.
entryGetIconSensitive ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the icon is sensitive.
entryGetIconSensitive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> m Bool
entryGetIconSensitive a
entry EntryIconPosition
iconPos = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    result <- gtk_entry_get_icon_sensitive entry' iconPos'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetIconSensitiveMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m Bool), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetIconSensitiveMethodInfo a signature where
    overloadedMethod = entryGetIconSensitive

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


#endif

-- method Entry::get_icon_storage_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "ImageType" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_get_icon_storage_type" gtk_entry_get_icon_storage_type :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    IO CUInt

-- | Gets the type of representation being used by the icon
-- to store image data.
-- 
-- If the icon has no image data, the return value will
-- be 'GI.Gtk.Enums.ImageTypeEmpty'.
entryGetIconStorageType ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m Gtk.Enums.ImageType
    -- ^ __Returns:__ image representation being used
entryGetIconStorageType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> m ImageType
entryGetIconStorageType a
entry EntryIconPosition
iconPos = IO ImageType -> m ImageType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImageType -> m ImageType) -> IO ImageType -> m ImageType
forall a b. (a -> b) -> a -> b
$ do
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    result <- gtk_entry_get_icon_storage_type entry' iconPos'
    let result' = (Int -> ImageType
forall a. Enum a => Int -> a
toEnum (Int -> ImageType) -> (CUInt -> Int) -> CUInt -> ImageType
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 entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetIconStorageTypeMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m Gtk.Enums.ImageType), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetIconStorageTypeMethodInfo a signature where
    overloadedMethod = entryGetIconStorageType

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


#endif

-- method Entry::get_icon_tooltip_markup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the icon position" , 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_entry_get_icon_tooltip_markup" gtk_entry_get_icon_tooltip_markup :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    IO CString

-- | Gets the contents of the tooltip on the icon at the specified
-- position in /@entry@/.
entryGetIconTooltipMarkup ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: the icon position
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the tooltip text
entryGetIconTooltipMarkup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> m (Maybe Text)
entryGetIconTooltipMarkup a
entry EntryIconPosition
iconPos = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    result <- gtk_entry_get_icon_tooltip_markup entry' iconPos'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        freeMem result'
        return result''
    touchManagedPtr entry
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetIconTooltipMarkupMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Maybe T.Text)), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetIconTooltipMarkupMethodInfo a signature where
    overloadedMethod = entryGetIconTooltipMarkup

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


#endif

-- method Entry::get_icon_tooltip_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the icon position" , 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_entry_get_icon_tooltip_text" gtk_entry_get_icon_tooltip_text :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    IO CString

-- | Gets the contents of the tooltip on the icon at the specified
-- position in /@entry@/.
entryGetIconTooltipText ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: the icon position
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the tooltip text
entryGetIconTooltipText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> m (Maybe Text)
entryGetIconTooltipText a
entry EntryIconPosition
iconPos = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    result <- gtk_entry_get_icon_tooltip_text entry' iconPos'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        freeMem result'
        return result''
    touchManagedPtr entry
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetIconTooltipTextMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Maybe T.Text)), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetIconTooltipTextMethodInfo a signature where
    overloadedMethod = entryGetIconTooltipText

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


#endif

-- method Entry::get_input_hints
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_input_hints" gtk_entry_get_input_hints :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CUInt

-- | Gets the input hints of this @GtkEntry@.
entryGetInputHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m [Gtk.Flags.InputHints]
    -- ^ __Returns:__ the input hints
entryGetInputHints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m [InputHints]
entryGetInputHints a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_input_hints entry'
    let result' = CUInt -> [InputHints]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    touchManagedPtr entry
    return result'

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

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


#endif

-- method Entry::get_input_purpose
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_input_purpose" gtk_entry_get_input_purpose :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CUInt

-- | Gets the input purpose of the @GtkEntry@.
entryGetInputPurpose ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Gtk.Enums.InputPurpose
    -- ^ __Returns:__ the input purpose
entryGetInputPurpose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m InputPurpose
entryGetInputPurpose a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_input_purpose entry'
    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 entry
    return result'

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

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


#endif

-- method Entry::get_invisible_char
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_invisible_char" gtk_entry_get_invisible_char :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CInt

-- | Retrieves the character displayed in place of the actual text
-- in “password mode”.
entryGetInvisibleChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Char
    -- ^ __Returns:__ the current invisible char, or 0, if the entry does not
    --   show invisible text at all.
entryGetInvisibleChar :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Char
entryGetInvisibleChar a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_invisible_char entry'
    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 entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetInvisibleCharMethodInfo
instance (signature ~ (m Char), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetInvisibleCharMethodInfo a signature where
    overloadedMethod = entryGetInvisibleChar

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


#endif

-- method Entry::get_max_length
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_max_length" gtk_entry_get_max_length :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO Int32

-- | Retrieves the maximum allowed length of the text in /@entry@/.
-- 
-- See 'GI.Gtk.Objects.Entry.entrySetMaxLength'.
entryGetMaxLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Int32
    -- ^ __Returns:__ the maximum allowed number of characters
    --   in @GtkEntry@, or 0 if there is no maximum.
entryGetMaxLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Int32
entryGetMaxLength a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_max_length entry'
    touchManagedPtr entry
    return result

#if defined(ENABLE_OVERLOADING)
data EntryGetMaxLengthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetMaxLengthMethodInfo a signature where
    overloadedMethod = entryGetMaxLength

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


#endif

-- method Entry::get_overwrite_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_overwrite_mode" gtk_entry_get_overwrite_mode :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CInt

-- | Gets whether the @GtkEntry@ is in overwrite mode.
entryGetOverwriteMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Bool
    -- ^ __Returns:__ whether the text is overwritten when typing.
entryGetOverwriteMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Bool
entryGetOverwriteMode a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_overwrite_mode entry'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetOverwriteModeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetOverwriteModeMethodInfo a signature where
    overloadedMethod = entryGetOverwriteMode

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


#endif

-- method Entry::get_placeholder_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_placeholder_text" gtk_entry_get_placeholder_text :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CString

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

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

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


#endif

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

foreign import ccall "gtk_entry_get_progress_fraction" gtk_entry_get_progress_fraction :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CDouble

-- | Returns the current fraction of the task that’s been completed.
-- 
-- See 'GI.Gtk.Objects.Entry.entrySetProgressFraction'.
entryGetProgressFraction ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Double
    -- ^ __Returns:__ a fraction from 0.0 to 1.0
entryGetProgressFraction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Double
entryGetProgressFraction a
entry = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_progress_fraction entry'
    let result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetProgressFractionMethodInfo
instance (signature ~ (m Double), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetProgressFractionMethodInfo a signature where
    overloadedMethod = entryGetProgressFraction

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


#endif

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

foreign import ccall "gtk_entry_get_progress_pulse_step" gtk_entry_get_progress_pulse_step :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CDouble

-- | Retrieves the pulse step set with
-- 'GI.Gtk.Objects.Entry.entrySetProgressPulseStep'.
entryGetProgressPulseStep ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Double
    -- ^ __Returns:__ a fraction from 0.0 to 1.0
entryGetProgressPulseStep :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Double
entryGetProgressPulseStep a
entry = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_progress_pulse_step entry'
    let result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetProgressPulseStepMethodInfo
instance (signature ~ (m Double), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetProgressPulseStepMethodInfo a signature where
    overloadedMethod = entryGetProgressPulseStep

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


#endif

-- method Entry::get_tabs
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_tabs" gtk_entry_get_tabs :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO (Ptr Pango.TabArray.TabArray)

-- | Gets the tabstops of the @GtkEntry@.
-- 
-- See 'GI.Gtk.Objects.Entry.entrySetTabs'.
entryGetTabs ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m (Maybe Pango.TabArray.TabArray)
    -- ^ __Returns:__ the tabstops
entryGetTabs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m (Maybe TabArray)
entryGetTabs a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_tabs entry'
    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 entry
    return maybeResult

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

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


#endif

-- method Entry::get_text_length
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_text_length" gtk_entry_get_text_length :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO Word16

-- | Retrieves the current length of the text in /@entry@/.
-- 
-- This is equivalent to getting /@entry@/\'s @GtkEntryBuffer@
-- and calling 'GI.Gtk.Objects.EntryBuffer.entryBufferGetLength' on it.
entryGetTextLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Word16
    -- ^ __Returns:__ the current number of characters
    --   in @GtkEntry@, or 0 if there are none.
entryGetTextLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Word16
entryGetTextLength a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_text_length entry'
    touchManagedPtr entry
    return result

#if defined(ENABLE_OVERLOADING)
data EntryGetTextLengthMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetTextLengthMethodInfo a signature where
    overloadedMethod = entryGetTextLength

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


#endif

-- method Entry::get_visibility
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_get_visibility" gtk_entry_get_visibility :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CInt

-- | Retrieves whether the text in /@entry@/ is visible.
-- 
-- See 'GI.Gtk.Objects.Entry.entrySetVisibility'.
entryGetVisibility ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the text is currently visible
entryGetVisibility :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Bool
entryGetVisibility a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_get_visibility entry'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGetVisibilityMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGetVisibilityMethodInfo a signature where
    overloadedMethod = entryGetVisibility

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


#endif

-- method Entry::grab_focus_without_selecting
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_grab_focus_without_selecting" gtk_entry_grab_focus_without_selecting :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO CInt

-- | Causes /@entry@/ to have keyboard focus.
-- 
-- It behaves like 'GI.Gtk.Objects.Widget.widgetGrabFocus', except that it doesn\'t
-- select the contents of the entry. 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.
entryGrabFocusWithoutSelecting ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if focus is now inside /@self@/
entryGrabFocusWithoutSelecting :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Bool
entryGrabFocusWithoutSelecting a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    result <- gtk_entry_grab_focus_without_selecting entry'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr entry
    return result'

#if defined(ENABLE_OVERLOADING)
data EntryGrabFocusWithoutSelectingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEntry a) => O.OverloadedMethod EntryGrabFocusWithoutSelectingMethodInfo a signature where
    overloadedMethod = entryGrabFocusWithoutSelecting

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


#endif

-- method Entry::progress_pulse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_progress_pulse" gtk_entry_progress_pulse :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO ()

-- | Indicates that some progress is made, but you don’t
-- know how much.
-- 
-- Causes the entry’s progress indicator to enter “activity
-- mode”, where a block bounces back and forth. Each call to
-- 'GI.Gtk.Objects.Entry.entryProgressPulse' causes the block to move by a
-- little bit (the amount of movement per pulse is determined
-- by 'GI.Gtk.Objects.Entry.entrySetProgressPulseStep').
entryProgressPulse ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m ()
entryProgressPulse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m ()
entryProgressPulse a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    gtk_entry_progress_pulse entry'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntryProgressPulseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntryProgressPulseMethodInfo a signature where
    overloadedMethod = entryProgressPulse

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


#endif

-- method Entry::reset_im_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_reset_im_context" gtk_entry_reset_im_context :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO ()

-- | Reset the input method context of the entry if needed.
-- 
-- This can be necessary in the case where modifying the buffer
-- would confuse on-going input method behavior.
entryResetImContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m ()
entryResetImContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m ()
entryResetImContext a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    gtk_entry_reset_im_context entry'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntryResetImContextMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntryResetImContextMethodInfo a signature where
    overloadedMethod = entryResetImContext

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


#endif

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

foreign import ccall "gtk_entry_set_activates_default" gtk_entry_set_activates_default :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()

-- | Sets whether pressing Enter in the /@entry@/ will activate the default
-- widget for the window containing the entry.
-- 
-- This usually means that the dialog containing the entry will be closed,
-- since the default widget is usually one of the dialog buttons.
entrySetActivatesDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Bool
    -- ^ /@setting@/: 'P.True' to activate window’s default widget on Enter keypress
    -> m ()
entrySetActivatesDefault :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Bool -> m ()
entrySetActivatesDefault a
entry Bool
setting = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let setting' = (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
setting
    gtk_entry_set_activates_default entry' setting'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetActivatesDefaultMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetActivatesDefaultMethodInfo a signature where
    overloadedMethod = entrySetActivatesDefault

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


#endif

-- method Entry::set_alignment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "xalign"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The horizontal alignment, from 0 (left) to 1 (right).\n  Reversed for RTL layouts"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_set_alignment" gtk_entry_set_alignment :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CFloat ->                               -- xalign : TBasicType TFloat
    IO ()

-- | Sets the alignment for the contents of the entry.
-- 
-- This controls the horizontal positioning of the contents when
-- the displayed text is shorter than the width of the entry.
-- 
-- See also: [Editable:xalign]("GI.Gtk.Interfaces.Editable#g:attr:xalign")
entrySetAlignment ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Float
    -- ^ /@xalign@/: The horizontal alignment, from 0 (left) to 1 (right).
    --   Reversed for RTL layouts
    -> m ()
entrySetAlignment :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Float -> m ()
entrySetAlignment a
entry Float
xalign = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let xalign' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign
    gtk_entry_set_alignment entry' xalign'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetAlignmentMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetAlignmentMethodInfo a signature where
    overloadedMethod = entrySetAlignment

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


#endif

-- method Entry::set_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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 = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoAttrList`" , 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_entry_set_attributes" gtk_entry_set_attributes :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    Ptr Pango.AttrList.AttrList ->          -- attrs : TInterface (Name {namespace = "Pango", name = "AttrList"})
    IO ()

-- | Sets a @PangoAttrList@.
-- 
-- The attributes in the list are applied to the entry text.
-- 
-- Since the attributes will be applied to text that changes
-- as the user types, it makes most sense to use attributes
-- with unlimited extent.
entrySetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Pango.AttrList.AttrList
    -- ^ /@attrs@/: a @PangoAttrList@
    -> m ()
entrySetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> AttrList -> m ()
entrySetAttributes a
entry 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    attrs' <- unsafeManagedPtrGetPtr attrs
    gtk_entry_set_attributes entry' attrs'
    touchManagedPtr entry
    touchManagedPtr attrs
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetAttributesMethodInfo
instance (signature ~ (Pango.AttrList.AttrList -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetAttributesMethodInfo a signature where
    overloadedMethod = entrySetAttributes

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


#endif

-- method Entry::set_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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 "a `GtkEntryBuffer`" , 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_entry_set_buffer" gtk_entry_set_buffer :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    Ptr Gtk.EntryBuffer.EntryBuffer ->      -- buffer : TInterface (Name {namespace = "Gtk", name = "EntryBuffer"})
    IO ()

-- | Set the @GtkEntryBuffer@ object which holds the text for
-- this widget.
entrySetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a, Gtk.EntryBuffer.IsEntryBuffer b) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> b
    -- ^ /@buffer@/: a @GtkEntryBuffer@
    -> m ()
entrySetBuffer :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEntry a, IsEntryBuffer b) =>
a -> b -> m ()
entrySetBuffer a
entry 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    buffer' <- unsafeManagedPtrCastPtr buffer
    gtk_entry_set_buffer entry' buffer'
    touchManagedPtr entry
    touchManagedPtr buffer
    return ()

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

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


#endif

-- method Entry::set_completion
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "completion"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryCompletion" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The `GtkEntryCompletion`"
--                 , 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_entry_set_completion" gtk_entry_set_completion :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    Ptr Gtk.EntryCompletion.EntryCompletion -> -- completion : TInterface (Name {namespace = "Gtk", name = "EntryCompletion"})
    IO ()

{-# DEPRECATED entrySetCompletion ["(Since version 4.10)","GtkEntryCompletion will be removed in GTK 5."] #-}
-- | Sets /@completion@/ to be the auxiliary completion object
-- to use with /@entry@/.
-- 
-- All further configuration of the completion mechanism is
-- done on /@completion@/ using the @GtkEntryCompletion@ API.
-- Completion is disabled if /@completion@/ is set to 'P.Nothing'.
entrySetCompletion ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a, Gtk.EntryCompletion.IsEntryCompletion b) =>
    a
    -- ^ /@entry@/: A @GtkEntry@
    -> Maybe (b)
    -- ^ /@completion@/: The @GtkEntryCompletion@
    -> m ()
entrySetCompletion :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEntry a, IsEntryCompletion b) =>
a -> Maybe b -> m ()
entrySetCompletion a
entry Maybe b
completion = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    maybeCompletion <- case completion of
        Maybe b
Nothing -> Ptr EntryCompletion -> IO (Ptr EntryCompletion)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr EntryCompletion
forall a. Ptr a
FP.nullPtr
        Just b
jCompletion -> do
            jCompletion' <- b -> IO (Ptr EntryCompletion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCompletion
            return jCompletion'
    gtk_entry_set_completion entry' maybeCompletion
    touchManagedPtr entry
    whenJust completion touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetCompletionMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsEntry a, Gtk.EntryCompletion.IsEntryCompletion b) => O.OverloadedMethod EntrySetCompletionMethodInfo a signature where
    overloadedMethod = entrySetCompletion

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


#endif

-- method Entry::set_extra_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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 `GMenuModel`" , 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_entry_set_extra_menu" gtk_entry_set_extra_menu :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    Ptr Gio.MenuModel.MenuModel ->          -- model : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Sets a menu model to add when constructing
-- the context menu for /@entry@/.
entrySetExtraMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Maybe (b)
    -- ^ /@model@/: a @GMenuModel@
    -> m ()
entrySetExtraMenu :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEntry a, IsMenuModel b) =>
a -> Maybe b -> m ()
entrySetExtraMenu a
entry 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    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_entry_set_extra_menu entry' maybeModel
    touchManagedPtr entry
    whenJust model touchManagedPtr
    return ()

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

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


#endif

-- method Entry::set_has_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "setting"
--           , 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_entry_set_has_frame" gtk_entry_set_has_frame :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()

-- | Sets whether the entry has a beveled frame around it.
entrySetHasFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Bool
    -- ^ /@setting@/: new value
    -> m ()
entrySetHasFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Bool -> m ()
entrySetHasFrame a
entry Bool
setting = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let setting' = (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
setting
    gtk_entry_set_has_frame entry' setting'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetHasFrameMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetHasFrameMethodInfo a signature where
    overloadedMethod = entrySetHasFrame

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


#endif

-- method Entry::set_icon_activatable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "activatable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if the icon should be activatable"
--                 , 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_entry_set_icon_activatable" gtk_entry_set_icon_activatable :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    CInt ->                                 -- activatable : TBasicType TBoolean
    IO ()

-- | Sets whether the icon is activatable.
entrySetIconActivatable ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> Bool
    -- ^ /@activatable@/: 'P.True' if the icon should be activatable
    -> m ()
entrySetIconActivatable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> Bool -> m ()
entrySetIconActivatable a
entry EntryIconPosition
iconPos Bool
activatable = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    let activatable' = (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
activatable
    gtk_entry_set_icon_activatable entry' iconPos' activatable'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconActivatableMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Bool -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetIconActivatableMethodInfo a signature where
    overloadedMethod = entrySetIconActivatable

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


#endif

-- method Entry::set_icon_drag_source
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "icon position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "provider"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkContentProvider`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actions"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a bitmask of the allowed drag actions"
--                 , 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_entry_set_icon_drag_source" gtk_entry_set_icon_drag_source :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    Ptr Gdk.ContentProvider.ContentProvider -> -- provider : TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
    CUInt ->                                -- actions : TInterface (Name {namespace = "Gdk", name = "DragAction"})
    IO ()

-- | Sets up the icon at the given position as drag source.
-- 
-- This makes it so that GTK will start a drag
-- operation when the user clicks and drags the icon.
entrySetIconDragSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a, Gdk.ContentProvider.IsContentProvider b) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: icon position
    -> b
    -- ^ /@provider@/: a @GdkContentProvider@
    -> [Gdk.Flags.DragAction]
    -- ^ /@actions@/: a bitmask of the allowed drag actions
    -> m ()
entrySetIconDragSource :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEntry a, IsContentProvider b) =>
a -> EntryIconPosition -> b -> [DragAction] -> m ()
entrySetIconDragSource a
entry EntryIconPosition
iconPos b
provider [DragAction]
actions = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    provider' <- unsafeManagedPtrCastPtr provider
    let actions' = [DragAction] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DragAction]
actions
    gtk_entry_set_icon_drag_source entry' iconPos' provider' actions'
    touchManagedPtr entry
    touchManagedPtr provider
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconDragSourceMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> b -> [Gdk.Flags.DragAction] -> m ()), MonadIO m, IsEntry a, Gdk.ContentProvider.IsContentProvider b) => O.OverloadedMethod EntrySetIconDragSourceMethodInfo a signature where
    overloadedMethod = entrySetIconDragSource

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


#endif

-- method Entry::set_icon_from_gicon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The position at which to set the icon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The icon to set" , 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_entry_set_icon_from_gicon" gtk_entry_set_icon_from_gicon :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    Ptr Gio.Icon.Icon ->                    -- icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    IO ()

-- | Sets the icon shown in the entry at the specified position
-- from the current icon theme.
-- 
-- If the icon isn’t known, a “broken image” icon will be
-- displayed instead.
-- 
-- If /@icon@/ is 'P.Nothing', no icon will be shown in the
-- specified position.
entrySetIconFromGicon ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a, Gio.Icon.IsIcon b) =>
    a
    -- ^ /@entry@/: A @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: The position at which to set the icon
    -> Maybe (b)
    -- ^ /@icon@/: The icon to set
    -> m ()
entrySetIconFromGicon :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEntry a, IsIcon b) =>
a -> EntryIconPosition -> Maybe b -> m ()
entrySetIconFromGicon a
entry EntryIconPosition
iconPos Maybe b
icon = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    maybeIcon <- case icon of
        Maybe b
Nothing -> Ptr Icon -> IO (Ptr Icon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
forall a. Ptr a
FP.nullPtr
        Just b
jIcon -> do
            jIcon' <- b -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jIcon
            return jIcon'
    gtk_entry_set_icon_from_gicon entry' iconPos' maybeIcon
    touchManagedPtr entry
    whenJust icon touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconFromGiconMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Maybe (b) -> m ()), MonadIO m, IsEntry a, Gio.Icon.IsIcon b) => O.OverloadedMethod EntrySetIconFromGiconMethodInfo a signature where
    overloadedMethod = entrySetIconFromGicon

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


#endif

-- method Entry::set_icon_from_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The position at which to set the icon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An icon name" , 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_entry_set_icon_from_icon_name" gtk_entry_set_icon_from_icon_name :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    CString ->                              -- icon_name : TBasicType TUTF8
    IO ()

-- | Sets the icon shown in the entry at the specified position
-- from the current icon theme.
-- 
-- If the icon name isn’t known, a “broken image” icon will be
-- displayed instead.
-- 
-- If /@iconName@/ is 'P.Nothing', no icon will be shown in the
-- specified position.
entrySetIconFromIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: The position at which to set the icon
    -> Maybe (T.Text)
    -- ^ /@iconName@/: An icon name
    -> m ()
entrySetIconFromIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> Maybe Text -> m ()
entrySetIconFromIconName a
entry EntryIconPosition
iconPos Maybe Text
iconName = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    maybeIconName <- case iconName 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
jIconName -> do
            jIconName' <- Text -> IO CString
textToCString Text
jIconName
            return jIconName'
    gtk_entry_set_icon_from_icon_name entry' iconPos' maybeIconName
    touchManagedPtr entry
    freeMem maybeIconName
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconFromIconNameMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Maybe (T.Text) -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetIconFromIconNameMethodInfo a signature where
    overloadedMethod = entrySetIconFromIconName

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


#endif

-- method Entry::set_icon_from_paintable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GdkPaintable`" , 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_entry_set_icon_from_paintable" gtk_entry_set_icon_from_paintable :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    Ptr Gdk.Paintable.Paintable ->          -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    IO ()

-- | Sets the icon shown in the specified position using a @GdkPaintable@.
-- 
-- If /@paintable@/ is 'P.Nothing', no icon will be shown in the specified position.
entrySetIconFromPaintable ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a, Gdk.Paintable.IsPaintable b) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> Maybe (b)
    -- ^ /@paintable@/: A @GdkPaintable@
    -> m ()
entrySetIconFromPaintable :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEntry a, IsPaintable b) =>
a -> EntryIconPosition -> Maybe b -> m ()
entrySetIconFromPaintable a
entry EntryIconPosition
iconPos Maybe b
paintable = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    maybePaintable <- case paintable of
        Maybe b
Nothing -> Ptr Paintable -> IO (Ptr Paintable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Paintable
forall a. Ptr a
FP.nullPtr
        Just b
jPaintable -> do
            jPaintable' <- b -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPaintable
            return jPaintable'
    gtk_entry_set_icon_from_paintable entry' iconPos' maybePaintable
    touchManagedPtr entry
    whenJust paintable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconFromPaintableMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Maybe (b) -> m ()), MonadIO m, IsEntry a, Gdk.Paintable.IsPaintable b) => O.OverloadedMethod EntrySetIconFromPaintableMethodInfo a signature where
    overloadedMethod = entrySetIconFromPaintable

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


#endif

-- method Entry::set_icon_sensitive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sensitive"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Specifies whether the icon should appear\n  sensitive or insensitive"
--                 , 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_entry_set_icon_sensitive" gtk_entry_set_icon_sensitive :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    CInt ->                                 -- sensitive : TBasicType TBoolean
    IO ()

-- | Sets the sensitivity for the specified icon.
entrySetIconSensitive ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> Bool
    -- ^ /@sensitive@/: Specifies whether the icon should appear
    --   sensitive or insensitive
    -> m ()
entrySetIconSensitive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> Bool -> m ()
entrySetIconSensitive a
entry EntryIconPosition
iconPos Bool
sensitive = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    let sensitive' = (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
sensitive
    gtk_entry_set_icon_sensitive entry' iconPos' sensitive'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconSensitiveMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Bool -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetIconSensitiveMethodInfo a signature where
    overloadedMethod = entrySetIconSensitive

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


#endif

-- method Entry::set_icon_tooltip_markup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the icon position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tooltip"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the contents of the tooltip for the icon"
--                 , 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_entry_set_icon_tooltip_markup" gtk_entry_set_icon_tooltip_markup :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    CString ->                              -- tooltip : TBasicType TUTF8
    IO ()

-- | Sets /@tooltip@/ as the contents of the tooltip for the icon at
-- the specified position.
-- 
-- /@tooltip@/ is assumed to be marked up with Pango Markup.
-- 
-- Use 'P.Nothing' for /@tooltip@/ to remove an existing tooltip.
-- 
-- See also 'GI.Gtk.Objects.Widget.widgetSetTooltipMarkup' and
-- 'GI.Gtk.Objects.Entry.entrySetIconTooltipText'.
entrySetIconTooltipMarkup ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: the icon position
    -> Maybe (T.Text)
    -- ^ /@tooltip@/: the contents of the tooltip for the icon
    -> m ()
entrySetIconTooltipMarkup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> Maybe Text -> m ()
entrySetIconTooltipMarkup a
entry EntryIconPosition
iconPos Maybe Text
tooltip = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    maybeTooltip <- case tooltip 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
jTooltip -> do
            jTooltip' <- Text -> IO CString
textToCString Text
jTooltip
            return jTooltip'
    gtk_entry_set_icon_tooltip_markup entry' iconPos' maybeTooltip
    touchManagedPtr entry
    freeMem maybeTooltip
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconTooltipMarkupMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Maybe (T.Text) -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetIconTooltipMarkupMethodInfo a signature where
    overloadedMethod = entrySetIconTooltipMarkup

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


#endif

-- method Entry::set_icon_tooltip_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_pos"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryIconPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the icon position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tooltip"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the contents of the tooltip for the icon"
--                 , 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_entry_set_icon_tooltip_text" gtk_entry_set_icon_tooltip_text :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- icon_pos : TInterface (Name {namespace = "Gtk", name = "EntryIconPosition"})
    CString ->                              -- tooltip : TBasicType TUTF8
    IO ()

-- | Sets /@tooltip@/ as the contents of the tooltip for the icon
-- at the specified position.
-- 
-- Use 'P.Nothing' for /@tooltip@/ to remove an existing tooltip.
-- 
-- See also 'GI.Gtk.Objects.Widget.widgetSetTooltipText' and
-- 'GI.Gtk.Objects.Entry.entrySetIconTooltipMarkup'.
-- 
-- If you unset the widget tooltip via
-- 'GI.Gtk.Objects.Widget.widgetSetTooltipText' or
-- 'GI.Gtk.Objects.Widget.widgetSetTooltipMarkup', this sets
-- [Widget:hasTooltip]("GI.Gtk.Objects.Widget#g:attr:hasTooltip") to 'P.False', which suppresses
-- icon tooltips too. You can resolve this by then calling
-- 'GI.Gtk.Objects.Widget.widgetSetHasTooltip' to set
-- [Widget:hasTooltip]("GI.Gtk.Objects.Widget#g:attr:hasTooltip") back to 'P.True', or
-- setting at least one non-empty tooltip on any icon
-- achieves the same result.
entrySetIconTooltipText ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: the icon position
    -> Maybe (T.Text)
    -- ^ /@tooltip@/: the contents of the tooltip for the icon
    -> m ()
entrySetIconTooltipText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> EntryIconPosition -> Maybe Text -> m ()
entrySetIconTooltipText a
entry EntryIconPosition
iconPos Maybe Text
tooltip = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (EntryIconPosition -> Int) -> EntryIconPosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> Int
forall a. Enum a => a -> Int
fromEnum) EntryIconPosition
iconPos
    maybeTooltip <- case tooltip 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
jTooltip -> do
            jTooltip' <- Text -> IO CString
textToCString Text
jTooltip
            return jTooltip'
    gtk_entry_set_icon_tooltip_text entry' iconPos' maybeTooltip
    touchManagedPtr entry
    freeMem maybeTooltip
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconTooltipTextMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Maybe (T.Text) -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetIconTooltipTextMethodInfo a signature where
    overloadedMethod = entrySetIconTooltipText

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


#endif

-- method Entry::set_input_hints
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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 "the 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_entry_set_input_hints" gtk_entry_set_input_hints :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- hints : TInterface (Name {namespace = "Gtk", name = "InputHints"})
    IO ()

-- | Set additional hints which allow input methods to
-- fine-tune their behavior.
entrySetInputHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> [Gtk.Flags.InputHints]
    -- ^ /@hints@/: the hints
    -> m ()
entrySetInputHints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> [InputHints] -> m ()
entrySetInputHints a
entry [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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let hints' = [InputHints] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [InputHints]
hints
    gtk_entry_set_input_hints entry' hints'
    touchManagedPtr entry
    return ()

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

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


#endif

-- method Entry::set_input_purpose
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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 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_entry_set_input_purpose" gtk_entry_set_input_purpose :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CUInt ->                                -- purpose : TInterface (Name {namespace = "Gtk", name = "InputPurpose"})
    IO ()

-- | Sets the input purpose which can be used by input methods
-- to adjust their behavior.
entrySetInputPurpose ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Gtk.Enums.InputPurpose
    -- ^ /@purpose@/: the purpose
    -> m ()
entrySetInputPurpose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> InputPurpose -> m ()
entrySetInputPurpose a
entry 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    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_entry_set_input_purpose entry' purpose'
    touchManagedPtr entry
    return ()

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

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


#endif

-- method Entry::set_invisible_char
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_set_invisible_char" gtk_entry_set_invisible_char :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CInt ->                                 -- ch : TBasicType TUniChar
    IO ()

-- | Sets the character to use in place of the actual text
-- in “password mode”.
-- 
-- See 'GI.Gtk.Objects.Entry.entrySetVisibility' for how to enable
-- “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.
entrySetInvisibleChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Char
    -- ^ /@ch@/: a Unicode character
    -> m ()
entrySetInvisibleChar :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Char -> m ()
entrySetInvisibleChar a
entry 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    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_entry_set_invisible_char entry' ch'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetInvisibleCharMethodInfo
instance (signature ~ (Char -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetInvisibleCharMethodInfo a signature where
    overloadedMethod = entrySetInvisibleChar

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


#endif

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

foreign import ccall "gtk_entry_set_max_length" gtk_entry_set_max_length :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    Int32 ->                                -- max : TBasicType TInt
    IO ()

-- | Sets the maximum allowed length of the contents of the widget.
-- 
-- If the current contents are longer than the given length, then
-- they will be truncated to fit. The length is in characters.
-- 
-- This is equivalent to getting /@entry@/\'s @GtkEntryBuffer@ and
-- calling 'GI.Gtk.Objects.EntryBuffer.entryBufferSetMaxLength' on it.
entrySetMaxLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Int32
    -- ^ /@max@/: the maximum length of the entry, 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 ()
entrySetMaxLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Int32 -> m ()
entrySetMaxLength a
entry Int32
max = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    gtk_entry_set_max_length entry' max
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetMaxLengthMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetMaxLengthMethodInfo a signature where
    overloadedMethod = entrySetMaxLength

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


#endif

-- method Entry::set_overwrite_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_set_overwrite_mode" gtk_entry_set_overwrite_mode :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CInt ->                                 -- overwrite : TBasicType TBoolean
    IO ()

-- | Sets whether the text is overwritten when typing in the @GtkEntry@.
entrySetOverwriteMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Bool
    -- ^ /@overwrite@/: new value
    -> m ()
entrySetOverwriteMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Bool -> m ()
entrySetOverwriteMode a
entry 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    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_entry_set_overwrite_mode entry' overwrite'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetOverwriteModeMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetOverwriteModeMethodInfo a signature where
    overloadedMethod = entrySetOverwriteMode

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


#endif

-- method Entry::set_placeholder_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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 @entry 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_entry_set_placeholder_text" gtk_entry_set_placeholder_text :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CString ->                              -- text : TBasicType TUTF8
    IO ()

-- | Sets text to be displayed in /@entry@/ when it is empty.
-- 
-- This can be used to give a visual hint of the expected
-- contents of the @GtkEntry@.
entrySetPlaceholderText ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Maybe (T.Text)
    -- ^ /@text@/: a string to be displayed when /@entry@/ is empty and unfocused
    -> m ()
entrySetPlaceholderText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Maybe Text -> m ()
entrySetPlaceholderText a
entry 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    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_entry_set_placeholder_text entry' maybeText
    touchManagedPtr entry
    freeMem maybeText
    return ()

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

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


#endif

-- method Entry::set_progress_fraction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fraction"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "fraction of the task that\8217s been completed"
--                 , 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_entry_set_progress_fraction" gtk_entry_set_progress_fraction :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CDouble ->                              -- fraction : TBasicType TDouble
    IO ()

-- | Causes the entry’s progress indicator to “fill in” the given
-- fraction of the bar.
-- 
-- The fraction should be between 0.0 and 1.0, inclusive.
entrySetProgressFraction ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Double
    -- ^ /@fraction@/: fraction of the task that’s been completed
    -> m ()
entrySetProgressFraction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Double -> m ()
entrySetProgressFraction a
entry Double
fraction = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let fraction' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fraction
    gtk_entry_set_progress_fraction entry' fraction'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetProgressFractionMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetProgressFractionMethodInfo a signature where
    overloadedMethod = entrySetProgressFraction

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


#endif

-- method Entry::set_progress_pulse_step
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fraction"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "fraction between 0.0 and 1.0"
--                 , 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_entry_set_progress_pulse_step" gtk_entry_set_progress_pulse_step :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CDouble ->                              -- fraction : TBasicType TDouble
    IO ()

-- | Sets the fraction of total entry width to move the progress
-- bouncing block for each pulse.
-- 
-- Use 'GI.Gtk.Objects.Entry.entryProgressPulse' to pulse
-- the progress.
entrySetProgressPulseStep ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Double
    -- ^ /@fraction@/: fraction between 0.0 and 1.0
    -> m ()
entrySetProgressPulseStep :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Double -> m ()
entrySetProgressPulseStep a
entry Double
fraction = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let fraction' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fraction
    gtk_entry_set_progress_pulse_step entry' fraction'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetProgressPulseStepMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetProgressPulseStepMethodInfo a signature where
    overloadedMethod = entrySetProgressPulseStep

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


#endif

-- method Entry::set_tabs
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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 "a `PangoTabArray`" , 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_entry_set_tabs" gtk_entry_set_tabs :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    Ptr Pango.TabArray.TabArray ->          -- tabs : TInterface (Name {namespace = "Pango", name = "TabArray"})
    IO ()

-- | Sets a @PangoTabArray@.
-- 
-- The tabstops in the array are applied to the entry text.
entrySetTabs ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Maybe (Pango.TabArray.TabArray)
    -- ^ /@tabs@/: a @PangoTabArray@
    -> m ()
entrySetTabs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Maybe TabArray -> m ()
entrySetTabs a
entry 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    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_entry_set_tabs entry' maybeTabs
    touchManagedPtr entry
    whenJust tabs touchManagedPtr
    return ()

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

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


#endif

-- method Entry::set_visibility
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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 entry are displayed as plaintext"
--                 , 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_entry_set_visibility" gtk_entry_set_visibility :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    CInt ->                                 -- visible : TBasicType TBoolean
    IO ()

-- | Sets whether the contents of the entry are visible or not.
-- 
-- When visibility is set to 'P.False', characters are displayed
-- as the invisible char, and will also appear that way when
-- the text in the entry widget is copied elsewhere.
-- 
-- By default, GTK picks the best invisible character available
-- in the current font, but it can be changed with
-- 'GI.Gtk.Objects.Entry.entrySetInvisibleChar'.
-- 
-- Note that you probably want to set [Entry:inputPurpose]("GI.Gtk.Objects.Entry#g:attr:inputPurpose")
-- to 'GI.Gtk.Enums.InputPurposePassword' or 'GI.Gtk.Enums.InputPurposePin' to
-- inform input methods about the purpose of this entry,
-- in addition to setting visibility to 'P.False'.
entrySetVisibility ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> Bool
    -- ^ /@visible@/: 'P.True' if the contents of the entry are displayed as plaintext
    -> m ()
entrySetVisibility :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Bool -> m ()
entrySetVisibility a
entry 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    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_entry_set_visibility entry' visible'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetVisibilityMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntrySetVisibilityMethodInfo a signature where
    overloadedMethod = entrySetVisibility

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


#endif

-- method Entry::unset_invisible_char
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Entry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkEntry`" , 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_entry_unset_invisible_char" gtk_entry_unset_invisible_char :: 
    Ptr Entry ->                            -- entry : TInterface (Name {namespace = "Gtk", name = "Entry"})
    IO ()

-- | Unsets the invisible char, so that the default invisible char
-- is used again. See 'GI.Gtk.Objects.Entry.entrySetInvisibleChar'.
entryUnsetInvisibleChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a @GtkEntry@
    -> m ()
entryUnsetInvisibleChar :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m ()
entryUnsetInvisibleChar a
entry = 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
    entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    gtk_entry_unset_invisible_char entry'
    touchManagedPtr entry
    return ()

#if defined(ENABLE_OVERLOADING)
data EntryUnsetInvisibleCharMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEntry a) => O.OverloadedMethod EntryUnsetInvisibleCharMethodInfo a signature where
    overloadedMethod = entryUnsetInvisibleChar

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


#endif