{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gtk.Objects.Entry.Entry' widget is a single line text entry
-- widget. A fairly large set of key bindings are supported
-- by default. If the entered text is longer than the allocation
-- of the widget, the widget will scroll so that the cursor
-- position is visible.
-- 
-- When using an entry for passwords and other sensitive information,
-- it can be put into “password mode” using 'GI.Gtk.Objects.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 [iconPress]("GI.Gtk.Objects.Entry#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
-- 
-- 
-- === /plain code/
-- >
-- >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'.

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


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

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


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


-- ** 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#
-- | /No description available in the introspection data./

#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 t'GI.Pango.Structs.Attribute.Attribute'\'s /@startIndex@/ and /@endIndex@/ must refer to the
-- t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' text, i.e. without the preedit string.

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


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

#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#
-- | /No description available in the introspection data./

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


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

#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
-- t'GI.Gtk.Objects.Settings.Settings':@/gtk-im-module/@ property.

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


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

#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
-- t'GI.Gtk.Objects.Entry.Entry':@/visibility/@.

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


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

#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 t'GI.Gtk.Objects.Entry.Entry'.

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


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

#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 t'GI.Gtk.Objects.Entry.Entry'.

#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 t'GI.Gtk.Objects.Entry.Entry' when it is empty
-- and unfocused.

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


-- ** populateAll #attr:populateAll#
-- | If :populate-all is 'P.True', the t'GI.Gtk.Objects.Entry.Entry'::@/populate-popup/@
-- signal is also emitted for touch popups.

#if defined(ENABLE_OVERLOADING)
    EntryPopulateAllPropertyInfo            ,
#endif
    constructEntryPopulateAll               ,
#if defined(ENABLE_OVERLOADING)
    entryPopulateAll                        ,
#endif
    getEntryPopulateAll                     ,
    setEntryPopulateAll                     ,


-- ** primaryIconActivatable #attr:primaryIconActivatable#
-- | Whether the primary icon is activatable.
-- 
-- GTK+ emits the [iconPress]("GI.Gtk.Objects.Entry#signal:iconPress") and [iconRelease]("GI.Gtk.Objects.Entry#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 t'GI.Gio.Interfaces.Icon.Icon' 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 t'GI.Gdk.Interfaces.Paintable.Paintable' 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
-- [iconPress]("GI.Gtk.Objects.Entry#signal:iconPress") and [iconRelease]("GI.Gtk.Objects.Entry#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, which is marked up
-- with the [Pango text markup language][PangoMarkupFormat].
-- 
-- 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 call to 'GI.Gtk.Objects.Entry.entryProgressPulse'.

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


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

#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 [iconPress]("GI.Gtk.Objects.Entry#signal:iconPress") and [iconRelease]("GI.Gtk.Objects.Entry#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 t'GI.Gio.Interfaces.Icon.Icon' 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 t'GI.Gdk.Interfaces.Paintable.Paintable' 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
-- [iconPress]("GI.Gtk.Objects.Entry#signal:iconPress") and [iconRelease]("GI.Gtk.Objects.Entry#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, which is marked up
-- with the [Pango text markup language][PangoMarkupFormat].
-- 
-- 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#
-- | /No description available in the introspection data./

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


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

#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 t'GI.Gtk.Objects.Entry.Entry'.

#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#
-- | /No description available in the introspection data./

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




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

    C_EntryActivateCallback                 ,
    EntryActivateCallback                   ,
#if defined(ENABLE_OVERLOADING)
    EntryActivateSignalInfo                 ,
#endif
    afterEntryActivate                      ,
    genClosure_EntryActivate                ,
    mk_EntryActivateCallback                ,
    noEntryActivateCallback                 ,
    onEntryActivate                         ,
    wrap_EntryActivateCallback              ,


-- ** iconPress #signal:iconPress#

    C_EntryIconPressCallback                ,
    EntryIconPressCallback                  ,
#if defined(ENABLE_OVERLOADING)
    EntryIconPressSignalInfo                ,
#endif
    afterEntryIconPress                     ,
    genClosure_EntryIconPress               ,
    mk_EntryIconPressCallback               ,
    noEntryIconPressCallback                ,
    onEntryIconPress                        ,
    wrap_EntryIconPressCallback             ,


-- ** iconRelease #signal:iconRelease#

    C_EntryIconReleaseCallback              ,
    EntryIconReleaseCallback                ,
#if defined(ENABLE_OVERLOADING)
    EntryIconReleaseSignalInfo              ,
#endif
    afterEntryIconRelease                   ,
    genClosure_EntryIconRelease             ,
    mk_EntryIconReleaseCallback             ,
    noEntryIconReleaseCallback              ,
    onEntryIconRelease                      ,
    wrap_EntryIconReleaseCallback           ,




    ) where

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

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

import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Structs.ContentFormats as Gdk.ContentFormats
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.CellEditable as Gtk.CellEditable
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

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

instance GObject Entry where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_entry_get_type
    

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

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

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

-- | Cast to `Entry`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toEntry :: (MonadIO m, IsEntry o) => o -> m Entry
toEntry :: o -> m Entry
toEntry = IO Entry -> m Entry
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Entry -> Entry
Entry

-- | A convenience alias for `Nothing` :: `Maybe` `Entry`.
noEntry :: Maybe Entry
noEntry :: Maybe Entry
noEntry = Maybe Entry
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveEntryMethod (t :: Symbol) (o :: *) :: * where
    ResolveEntryMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveEntryMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveEntryMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveEntryMethod "addAccelerator" o = Gtk.Widget.WidgetAddAcceleratorMethodInfo
    ResolveEntryMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveEntryMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveEntryMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveEntryMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveEntryMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveEntryMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveEntryMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveEntryMethod "canActivateAccel" o = Gtk.Widget.WidgetCanActivateAccelMethodInfo
    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 "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveEntryMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveEntryMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveEntryMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveEntryMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveEntryMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveEntryMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveEntryMethod "deleteSelection" o = Gtk.Editable.EditableDeleteSelectionMethodInfo
    ResolveEntryMethod "deleteText" o = Gtk.Editable.EditableDeleteTextMethodInfo
    ResolveEntryMethod "destroy" o = Gtk.Widget.WidgetDestroyMethodInfo
    ResolveEntryMethod "destroyed" o = Gtk.Widget.WidgetDestroyedMethodInfo
    ResolveEntryMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveEntryMethod "dragBegin" o = Gtk.Widget.WidgetDragBeginMethodInfo
    ResolveEntryMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveEntryMethod "dragDestAddImageTargets" o = Gtk.Widget.WidgetDragDestAddImageTargetsMethodInfo
    ResolveEntryMethod "dragDestAddTextTargets" o = Gtk.Widget.WidgetDragDestAddTextTargetsMethodInfo
    ResolveEntryMethod "dragDestAddUriTargets" o = Gtk.Widget.WidgetDragDestAddUriTargetsMethodInfo
    ResolveEntryMethod "dragDestFindTarget" o = Gtk.Widget.WidgetDragDestFindTargetMethodInfo
    ResolveEntryMethod "dragDestGetTargetList" o = Gtk.Widget.WidgetDragDestGetTargetListMethodInfo
    ResolveEntryMethod "dragDestGetTrackMotion" o = Gtk.Widget.WidgetDragDestGetTrackMotionMethodInfo
    ResolveEntryMethod "dragDestSet" o = Gtk.Widget.WidgetDragDestSetMethodInfo
    ResolveEntryMethod "dragDestSetTargetList" o = Gtk.Widget.WidgetDragDestSetTargetListMethodInfo
    ResolveEntryMethod "dragDestSetTrackMotion" o = Gtk.Widget.WidgetDragDestSetTrackMotionMethodInfo
    ResolveEntryMethod "dragDestUnset" o = Gtk.Widget.WidgetDragDestUnsetMethodInfo
    ResolveEntryMethod "dragGetData" o = Gtk.Widget.WidgetDragGetDataMethodInfo
    ResolveEntryMethod "dragHighlight" o = Gtk.Widget.WidgetDragHighlightMethodInfo
    ResolveEntryMethod "dragSourceAddImageTargets" o = Gtk.Widget.WidgetDragSourceAddImageTargetsMethodInfo
    ResolveEntryMethod "dragSourceAddTextTargets" o = Gtk.Widget.WidgetDragSourceAddTextTargetsMethodInfo
    ResolveEntryMethod "dragSourceAddUriTargets" o = Gtk.Widget.WidgetDragSourceAddUriTargetsMethodInfo
    ResolveEntryMethod "dragSourceGetTargetList" o = Gtk.Widget.WidgetDragSourceGetTargetListMethodInfo
    ResolveEntryMethod "dragSourceSet" o = Gtk.Widget.WidgetDragSourceSetMethodInfo
    ResolveEntryMethod "dragSourceSetIconGicon" o = Gtk.Widget.WidgetDragSourceSetIconGiconMethodInfo
    ResolveEntryMethod "dragSourceSetIconName" o = Gtk.Widget.WidgetDragSourceSetIconNameMethodInfo
    ResolveEntryMethod "dragSourceSetIconPaintable" o = Gtk.Widget.WidgetDragSourceSetIconPaintableMethodInfo
    ResolveEntryMethod "dragSourceSetTargetList" o = Gtk.Widget.WidgetDragSourceSetTargetListMethodInfo
    ResolveEntryMethod "dragSourceUnset" o = Gtk.Widget.WidgetDragSourceUnsetMethodInfo
    ResolveEntryMethod "dragUnhighlight" o = Gtk.Widget.WidgetDragUnhighlightMethodInfo
    ResolveEntryMethod "editingDone" o = Gtk.CellEditable.CellEditableEditingDoneMethodInfo
    ResolveEntryMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveEntryMethod "event" o = Gtk.Widget.WidgetEventMethodInfo
    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 "grabAdd" o = Gtk.Widget.WidgetGrabAddMethodInfo
    ResolveEntryMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveEntryMethod "grabFocusWithoutSelecting" o = EntryGrabFocusWithoutSelectingMethodInfo
    ResolveEntryMethod "grabRemove" o = Gtk.Widget.WidgetGrabRemoveMethodInfo
    ResolveEntryMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveEntryMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveEntryMethod "hasGrab" o = Gtk.Widget.WidgetHasGrabMethodInfo
    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 "inputShapeCombineRegion" o = Gtk.Widget.WidgetInputShapeCombineRegionMethodInfo
    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 "isToplevel" o = Gtk.Widget.WidgetIsToplevelMethodInfo
    ResolveEntryMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveEntryMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveEntryMethod "listAccelClosures" o = Gtk.Widget.WidgetListAccelClosuresMethodInfo
    ResolveEntryMethod "listActionPrefixes" o = Gtk.Widget.WidgetListActionPrefixesMethodInfo
    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 "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveEntryMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveEntryMethod "progressPulse" o = EntryProgressPulseMethodInfo
    ResolveEntryMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveEntryMethod "queueComputeExpand" o = Gtk.Widget.WidgetQueueComputeExpandMethodInfo
    ResolveEntryMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveEntryMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveEntryMethod "queueResizeNoRedraw" o = Gtk.Widget.WidgetQueueResizeNoRedrawMethodInfo
    ResolveEntryMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveEntryMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveEntryMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveEntryMethod "registerSurface" o = Gtk.Widget.WidgetRegisterSurfaceMethodInfo
    ResolveEntryMethod "removeAccelerator" o = Gtk.Widget.WidgetRemoveAcceleratorMethodInfo
    ResolveEntryMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveEntryMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveEntryMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveEntryMethod "removeWidget" o = Gtk.CellEditable.CellEditableRemoveWidgetMethodInfo
    ResolveEntryMethod "resetImContext" o = EntryResetImContextMethodInfo
    ResolveEntryMethod "resetStyle" o = Gtk.Widget.WidgetResetStyleMethodInfo
    ResolveEntryMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveEntryMethod "selectRegion" o = Gtk.Editable.EditableSelectRegionMethodInfo
    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 "unregisterSurface" o = Gtk.Widget.WidgetUnregisterSurfaceMethodInfo
    ResolveEntryMethod "unsetInvisibleChar" o = EntryUnsetInvisibleCharMethodInfo
    ResolveEntryMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveEntryMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveEntryMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveEntryMethod "getActionGroup" o = Gtk.Widget.WidgetGetActionGroupMethodInfo
    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 "getAttributes" o = EntryGetAttributesMethodInfo
    ResolveEntryMethod "getBuffer" o = EntryGetBufferMethodInfo
    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 "getCompletion" o = EntryGetCompletionMethodInfo
    ResolveEntryMethod "getCurrentIconDragSource" o = EntryGetCurrentIconDragSourceMethodInfo
    ResolveEntryMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveEntryMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveEntryMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveEntryMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveEntryMethod "getEditable" o = Gtk.Editable.EditableGetEditableMethodInfo
    ResolveEntryMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveEntryMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveEntryMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    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 "getHasSurface" o = Gtk.Widget.WidgetGetHasSurfaceMethodInfo
    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 "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveEntryMethod "getInvisibleChar" o = EntryGetInvisibleCharMethodInfo
    ResolveEntryMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveEntryMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    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 "getModifierMask" o = Gtk.Widget.WidgetGetModifierMaskMethodInfo
    ResolveEntryMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    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 "getPath" o = Gtk.Widget.WidgetGetPathMethodInfo
    ResolveEntryMethod "getPlaceholderText" o = EntryGetPlaceholderTextMethodInfo
    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 "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveEntryMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveEntryMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveEntryMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveEntryMethod "getSurface" o = Gtk.Widget.WidgetGetSurfaceMethodInfo
    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 "getTooltipWindow" o = Gtk.Widget.WidgetGetTooltipWindowMethodInfo
    ResolveEntryMethod "getToplevel" o = Gtk.Widget.WidgetGetToplevelMethodInfo
    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 "setAccelPath" o = Gtk.Widget.WidgetSetAccelPathMethodInfo
    ResolveEntryMethod "setActivatesDefault" o = EntrySetActivatesDefaultMethodInfo
    ResolveEntryMethod "setAlignment" o = EntrySetAlignmentMethodInfo
    ResolveEntryMethod "setAttributes" o = EntrySetAttributesMethodInfo
    ResolveEntryMethod "setBuffer" o = EntrySetBufferMethodInfo
    ResolveEntryMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveEntryMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveEntryMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveEntryMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveEntryMethod "setCompletion" o = EntrySetCompletionMethodInfo
    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 "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveEntryMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveEntryMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveEntryMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveEntryMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveEntryMethod "setHasFrame" o = EntrySetHasFrameMethodInfo
    ResolveEntryMethod "setHasSurface" o = Gtk.Widget.WidgetSetHasSurfaceMethodInfo
    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 "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 "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveEntryMethod "setSurface" o = Gtk.Widget.WidgetSetSurfaceMethodInfo
    ResolveEntryMethod "setTabs" o = EntrySetTabsMethodInfo
    ResolveEntryMethod "setText" o = Gtk.Editable.EditableSetTextMethodInfo
    ResolveEntryMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveEntryMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveEntryMethod "setTooltipWindow" o = Gtk.Widget.WidgetSetTooltipWindowMethodInfo
    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.MethodInfo 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

#endif

-- signal Entry::activate
-- | /No description available in the introspection data./
type EntryActivateCallback =
    IO ()

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

-- | Type for the callback on the (unwrapped) C side.
type C_EntryActivateCallback =
    Ptr () ->                               -- 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 the callback into a `GClosure`.
genClosure_EntryActivate :: MonadIO m => EntryActivateCallback -> m (GClosure C_EntryActivateCallback)
genClosure_EntryActivate :: IO () -> m (GClosure C_EntryActivateCallback)
genClosure_EntryActivate cb :: IO ()
cb = IO (GClosure C_EntryActivateCallback)
-> m (GClosure C_EntryActivateCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_EntryActivateCallback)
 -> m (GClosure C_EntryActivateCallback))
-> IO (GClosure C_EntryActivateCallback)
-> m (GClosure C_EntryActivateCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EntryActivateCallback
cb' = IO () -> C_EntryActivateCallback
wrap_EntryActivateCallback IO ()
cb
    C_EntryActivateCallback -> IO (FunPtr C_EntryActivateCallback)
mk_EntryActivateCallback C_EntryActivateCallback
cb' IO (FunPtr C_EntryActivateCallback)
-> (FunPtr C_EntryActivateCallback
    -> IO (GClosure C_EntryActivateCallback))
-> IO (GClosure C_EntryActivateCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_EntryActivateCallback
-> IO (GClosure C_EntryActivateCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `EntryActivateCallback` into a `C_EntryActivateCallback`.
wrap_EntryActivateCallback ::
    EntryActivateCallback ->
    C_EntryActivateCallback
wrap_EntryActivateCallback :: IO () -> C_EntryActivateCallback
wrap_EntryActivateCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [activate](#signal:activate) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' entry #activate callback
-- @
-- 
-- 
onEntryActivate :: (IsEntry a, MonadIO m) => a -> EntryActivateCallback -> m SignalHandlerId
onEntryActivate :: a -> IO () -> m SignalHandlerId
onEntryActivate obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EntryActivateCallback
cb' = IO () -> C_EntryActivateCallback
wrap_EntryActivateCallback IO ()
cb
    FunPtr C_EntryActivateCallback
cb'' <- C_EntryActivateCallback -> IO (FunPtr C_EntryActivateCallback)
mk_EntryActivateCallback C_EntryActivateCallback
cb'
    a
-> Text
-> FunPtr C_EntryActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "activate" FunPtr C_EntryActivateCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [activate](#signal:activate) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' entry #activate callback
-- @
-- 
-- 
afterEntryActivate :: (IsEntry a, MonadIO m) => a -> EntryActivateCallback -> m SignalHandlerId
afterEntryActivate :: a -> IO () -> m SignalHandlerId
afterEntryActivate obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EntryActivateCallback
cb' = IO () -> C_EntryActivateCallback
wrap_EntryActivateCallback IO ()
cb
    FunPtr C_EntryActivateCallback
cb'' <- C_EntryActivateCallback -> IO (FunPtr C_EntryActivateCallback)
mk_EntryActivateCallback C_EntryActivateCallback
cb'
    a
-> Text
-> FunPtr C_EntryActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "activate" FunPtr C_EntryActivateCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
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

#endif

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

-- | A convenience synonym for @`Nothing` :: `Maybe` `EntryIconPressCallback`@.
noEntryIconPressCallback :: Maybe EntryIconPressCallback
noEntryIconPressCallback :: Maybe EntryIconPressCallback
noEntryIconPressCallback = Maybe EntryIconPressCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_EntryIconPressCallback =
    Ptr () ->                               -- 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 the callback into a `GClosure`.
genClosure_EntryIconPress :: MonadIO m => EntryIconPressCallback -> m (GClosure C_EntryIconPressCallback)
genClosure_EntryIconPress :: EntryIconPressCallback -> m (GClosure C_EntryIconPressCallback)
genClosure_EntryIconPress cb :: EntryIconPressCallback
cb = IO (GClosure C_EntryIconPressCallback)
-> m (GClosure C_EntryIconPressCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_EntryIconPressCallback)
 -> m (GClosure C_EntryIconPressCallback))
-> IO (GClosure C_EntryIconPressCallback)
-> m (GClosure C_EntryIconPressCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EntryIconPressCallback
cb' = EntryIconPressCallback -> C_EntryIconPressCallback
wrap_EntryIconPressCallback EntryIconPressCallback
cb
    C_EntryIconPressCallback -> IO (FunPtr C_EntryIconPressCallback)
mk_EntryIconPressCallback C_EntryIconPressCallback
cb' IO (FunPtr C_EntryIconPressCallback)
-> (FunPtr C_EntryIconPressCallback
    -> IO (GClosure C_EntryIconPressCallback))
-> IO (GClosure C_EntryIconPressCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_EntryIconPressCallback
-> IO (GClosure C_EntryIconPressCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `EntryIconPressCallback` into a `C_EntryIconPressCallback`.
wrap_EntryIconPressCallback ::
    EntryIconPressCallback ->
    C_EntryIconPressCallback
wrap_EntryIconPressCallback :: EntryIconPressCallback -> C_EntryIconPressCallback
wrap_EntryIconPressCallback _cb :: EntryIconPressCallback
_cb _ iconPos :: CUInt
iconPos _ = 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
    EntryIconPressCallback
_cb  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 -> EntryIconPressCallback -> m SignalHandlerId
onEntryIconPress :: a -> EntryIconPressCallback -> m SignalHandlerId
onEntryIconPress obj :: a
obj cb :: EntryIconPressCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EntryIconPressCallback
cb' = EntryIconPressCallback -> C_EntryIconPressCallback
wrap_EntryIconPressCallback EntryIconPressCallback
cb
    FunPtr C_EntryIconPressCallback
cb'' <- C_EntryIconPressCallback -> IO (FunPtr C_EntryIconPressCallback)
mk_EntryIconPressCallback C_EntryIconPressCallback
cb'
    a
-> Text
-> FunPtr C_EntryIconPressCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "icon-press" FunPtr C_EntryIconPressCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
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
-- @
-- 
-- 
afterEntryIconPress :: (IsEntry a, MonadIO m) => a -> EntryIconPressCallback -> m SignalHandlerId
afterEntryIconPress :: a -> EntryIconPressCallback -> m SignalHandlerId
afterEntryIconPress obj :: a
obj cb :: EntryIconPressCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EntryIconPressCallback
cb' = EntryIconPressCallback -> C_EntryIconPressCallback
wrap_EntryIconPressCallback EntryIconPressCallback
cb
    FunPtr C_EntryIconPressCallback
cb'' <- C_EntryIconPressCallback -> IO (FunPtr C_EntryIconPressCallback)
mk_EntryIconPressCallback C_EntryIconPressCallback
cb'
    a
-> Text
-> FunPtr C_EntryIconPressCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "icon-press" FunPtr C_EntryIconPressCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
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

#endif

-- signal Entry::icon-release
-- | The [iconRelease](#signal:iconRelease) signal is 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 ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `EntryIconReleaseCallback`@.
noEntryIconReleaseCallback :: Maybe EntryIconReleaseCallback
noEntryIconReleaseCallback :: Maybe EntryIconPressCallback
noEntryIconReleaseCallback = Maybe EntryIconPressCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_EntryIconReleaseCallback =
    Ptr () ->                               -- 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 the callback into a `GClosure`.
genClosure_EntryIconRelease :: MonadIO m => EntryIconReleaseCallback -> m (GClosure C_EntryIconReleaseCallback)
genClosure_EntryIconRelease :: EntryIconPressCallback -> m (GClosure C_EntryIconPressCallback)
genClosure_EntryIconRelease cb :: EntryIconPressCallback
cb = IO (GClosure C_EntryIconPressCallback)
-> m (GClosure C_EntryIconPressCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_EntryIconPressCallback)
 -> m (GClosure C_EntryIconPressCallback))
-> IO (GClosure C_EntryIconPressCallback)
-> m (GClosure C_EntryIconPressCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EntryIconPressCallback
cb' = EntryIconPressCallback -> C_EntryIconPressCallback
wrap_EntryIconReleaseCallback EntryIconPressCallback
cb
    C_EntryIconPressCallback -> IO (FunPtr C_EntryIconPressCallback)
mk_EntryIconReleaseCallback C_EntryIconPressCallback
cb' IO (FunPtr C_EntryIconPressCallback)
-> (FunPtr C_EntryIconPressCallback
    -> IO (GClosure C_EntryIconPressCallback))
-> IO (GClosure C_EntryIconPressCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_EntryIconPressCallback
-> IO (GClosure C_EntryIconPressCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `EntryIconReleaseCallback` into a `C_EntryIconReleaseCallback`.
wrap_EntryIconReleaseCallback ::
    EntryIconReleaseCallback ->
    C_EntryIconReleaseCallback
wrap_EntryIconReleaseCallback :: EntryIconPressCallback -> C_EntryIconPressCallback
wrap_EntryIconReleaseCallback _cb :: EntryIconPressCallback
_cb _ iconPos :: CUInt
iconPos _ = 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
    EntryIconPressCallback
_cb  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 -> EntryIconReleaseCallback -> m SignalHandlerId
onEntryIconRelease :: a -> EntryIconPressCallback -> m SignalHandlerId
onEntryIconRelease obj :: a
obj cb :: EntryIconPressCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EntryIconPressCallback
cb' = EntryIconPressCallback -> C_EntryIconPressCallback
wrap_EntryIconReleaseCallback EntryIconPressCallback
cb
    FunPtr C_EntryIconPressCallback
cb'' <- C_EntryIconPressCallback -> IO (FunPtr C_EntryIconPressCallback)
mk_EntryIconReleaseCallback C_EntryIconPressCallback
cb'
    a
-> Text
-> FunPtr C_EntryIconPressCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "icon-release" FunPtr C_EntryIconPressCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
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
-- @
-- 
-- 
afterEntryIconRelease :: (IsEntry a, MonadIO m) => a -> EntryIconReleaseCallback -> m SignalHandlerId
afterEntryIconRelease :: a -> EntryIconPressCallback -> m SignalHandlerId
afterEntryIconRelease obj :: a
obj cb :: EntryIconPressCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_EntryIconPressCallback
cb' = EntryIconPressCallback -> C_EntryIconPressCallback
wrap_EntryIconReleaseCallback EntryIconPressCallback
cb
    FunPtr C_EntryIconPressCallback
cb'' <- C_EntryIconPressCallback -> IO (FunPtr C_EntryIconPressCallback)
mk_EntryIconReleaseCallback C_EntryIconPressCallback
cb'
    a
-> Text
-> FunPtr C_EntryIconPressCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "icon-release" FunPtr C_EntryIconPressCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
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

#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 :: o -> m Bool
getEntryActivatesDefault obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "activates-default"

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m (Maybe AttrList)
getEntryAttributes obj :: o
obj = IO (Maybe AttrList) -> m (Maybe AttrList)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AttrList) -> m (Maybe AttrList))
-> IO (Maybe AttrList) -> m (Maybe AttrList)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr AttrList -> AttrList)
-> IO (Maybe AttrList)
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj "attributes" ManagedPtr AttrList -> AttrList
Pango.AttrList.AttrList

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m EntryBuffer
getEntryBuffer obj :: o
obj = IO EntryBuffer -> m EntryBuffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntryBuffer -> m EntryBuffer)
-> IO EntryBuffer -> m EntryBuffer
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe EntryBuffer) -> IO EntryBuffer
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "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 "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 :: o -> a -> m ()
setEntryBuffer obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "buffer" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

#if defined(ENABLE_OVERLOADING)
data 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
#endif

-- VVV Prop "completion"
   -- Type: TInterface (Name {namespace = "Gtk", name = "EntryCompletion"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,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 Gtk.EntryCompletion.EntryCompletion
getEntryCompletion :: o -> m EntryCompletion
getEntryCompletion obj :: o
obj = IO EntryCompletion -> m EntryCompletion
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntryCompletion -> m EntryCompletion)
-> IO EntryCompletion -> m EntryCompletion
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe EntryCompletion) -> IO EntryCompletion
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getEntryCompletion" (IO (Maybe EntryCompletion) -> IO EntryCompletion)
-> IO (Maybe EntryCompletion) -> IO 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 "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 :: o -> a -> m ()
setEntryCompletion obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "completion" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `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, Gtk.EntryCompletion.IsEntryCompletion a) => a -> IO (GValueConstruct o)
constructEntryCompletion :: a -> IO (GValueConstruct o)
constructEntryCompletion val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "completion" (a -> Maybe a
forall a. a -> Maybe a
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 :: o -> m ()
clearEntryCompletion obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe EntryCompletion -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "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 = 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
#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 :: o -> m Bool
getEntryEnableEmojiCompletion obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "enable-emoji-completion"

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m Bool
getEntryHasFrame obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "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 :: o -> Bool -> m ()
setEntryHasFrame obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "has-frame" Bool
val

-- | Construct a `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) => Bool -> IO (GValueConstruct o)
constructEntryHasFrame :: Bool -> IO (GValueConstruct o)
constructEntryHasFrame val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "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
#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 :: o -> m (Maybe Text)
getEntryImModule obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "im-module"

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

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m [InputHints]
getEntryInputHints obj :: o
obj = IO [InputHints] -> m [InputHints]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [InputHints] -> m [InputHints])
-> IO [InputHints] -> m [InputHints]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [InputHints]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj "input-hints"

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m InputPurpose
getEntryInputPurpose obj :: o
obj = IO InputPurpose -> m InputPurpose
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputPurpose -> m InputPurpose)
-> IO InputPurpose -> m InputPurpose
forall a b. (a -> b) -> a -> b
$ o -> String -> IO InputPurpose
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "input-purpose"

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m Word32
getEntryInvisibleChar obj :: o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj "invisible-char"

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m Bool
getEntryInvisibleCharSet obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "invisible-char-set"

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m Int32
getEntryMaxLength obj :: o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj "max-length"

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m Bool
getEntryOverwriteMode obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "overwrite-mode"

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m (Maybe Text)
getEntryPlaceholderText obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "placeholder-text"

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

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data EntryPopulateAllPropertyInfo
instance AttrInfo EntryPopulateAllPropertyInfo where
    type AttrAllowedOps EntryPopulateAllPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EntryPopulateAllPropertyInfo = IsEntry
    type AttrSetTypeConstraint EntryPopulateAllPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint EntryPopulateAllPropertyInfo = (~) Bool
    type AttrTransferType EntryPopulateAllPropertyInfo = Bool
    type AttrGetType EntryPopulateAllPropertyInfo = Bool
    type AttrLabel EntryPopulateAllPropertyInfo = "populate-all"
    type AttrOrigin EntryPopulateAllPropertyInfo = Entry
    attrGet = getEntryPopulateAll
    attrSet = setEntryPopulateAll
    attrTransfer _ v = do
        return v
    attrConstruct = constructEntryPopulateAll
    attrClear = undefined
#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 :: o -> m Bool
getEntryPrimaryIconActivatable obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "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 :: o -> Bool -> m ()
setEntryPrimaryIconActivatable obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "primary-icon-activatable" Bool
val

-- | Construct a `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) => Bool -> IO (GValueConstruct o)
constructEntryPrimaryIconActivatable :: Bool -> IO (GValueConstruct o)
constructEntryPrimaryIconActivatable val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "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
#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 :: o -> m (Maybe Icon)
getEntryPrimaryIconGicon obj :: o
obj = IO (Maybe Icon) -> m (Maybe Icon)
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
$ 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 "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 :: o -> a -> m ()
setEntryPrimaryIconGicon obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "primary-icon-gicon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `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, Gio.Icon.IsIcon a) => a -> IO (GValueConstruct o)
constructEntryPrimaryIconGicon :: a -> IO (GValueConstruct o)
constructEntryPrimaryIconGicon val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "primary-icon-gicon" (a -> Maybe a
forall a. a -> Maybe a
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 :: o -> m ()
clearEntryPrimaryIconGicon obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Icon -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "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
#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 :: o -> m (Maybe Text)
getEntryPrimaryIconName obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setEntryPrimaryIconName obj :: o
obj val :: Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "primary-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `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) => T.Text -> IO (GValueConstruct o)
constructEntryPrimaryIconName :: Text -> IO (GValueConstruct o)
constructEntryPrimaryIconName val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "primary-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
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 :: o -> m ()
clearEntryPrimaryIconName obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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
#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 :: o -> m (Maybe Paintable)
getEntryPrimaryIconPaintable obj :: o
obj = IO (Maybe Paintable) -> m (Maybe Paintable)
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
$ 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 "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 :: o -> a -> m ()
setEntryPrimaryIconPaintable obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "primary-icon-paintable" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `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, Gdk.Paintable.IsPaintable a) => a -> IO (GValueConstruct o)
constructEntryPrimaryIconPaintable :: a -> IO (GValueConstruct o)
constructEntryPrimaryIconPaintable val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "primary-icon-paintable" (a -> Maybe a
forall a. a -> Maybe a
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 :: o -> m ()
clearEntryPrimaryIconPaintable obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Paintable -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "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
#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 :: o -> m Bool
getEntryPrimaryIconSensitive obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "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 :: o -> Bool -> m ()
setEntryPrimaryIconSensitive obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "primary-icon-sensitive" Bool
val

-- | Construct a `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) => Bool -> IO (GValueConstruct o)
constructEntryPrimaryIconSensitive :: Bool -> IO (GValueConstruct o)
constructEntryPrimaryIconSensitive val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "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
#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 :: o -> m ImageType
getEntryPrimaryIconStorageType obj :: o
obj = IO ImageType -> m ImageType
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
$ o -> String -> IO ImageType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "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
#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 :: o -> m (Maybe Text)
getEntryPrimaryIconTooltipMarkup obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setEntryPrimaryIconTooltipMarkup obj :: o
obj val :: Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "primary-icon-tooltip-markup" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `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) => T.Text -> IO (GValueConstruct o)
constructEntryPrimaryIconTooltipMarkup :: Text -> IO (GValueConstruct o)
constructEntryPrimaryIconTooltipMarkup val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "primary-icon-tooltip-markup" (Text -> Maybe Text
forall a. a -> Maybe a
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 :: o -> m ()
clearEntryPrimaryIconTooltipMarkup obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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
#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 :: o -> m (Maybe Text)
getEntryPrimaryIconTooltipText obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setEntryPrimaryIconTooltipText obj :: o
obj val :: Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "primary-icon-tooltip-text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `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) => T.Text -> IO (GValueConstruct o)
constructEntryPrimaryIconTooltipText :: Text -> IO (GValueConstruct o)
constructEntryPrimaryIconTooltipText val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "primary-icon-tooltip-text" (Text -> Maybe Text
forall a. a -> Maybe a
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 :: o -> m ()
clearEntryPrimaryIconTooltipText obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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
#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 :: o -> m Double
getEntryProgressFraction obj :: o
obj = IO Double -> m Double
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
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj "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 :: o -> Double -> m ()
setEntryProgressFraction obj :: o
obj val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj "progress-fraction" Double
val

-- | Construct a `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) => Double -> IO (GValueConstruct o)
constructEntryProgressFraction :: Double -> IO (GValueConstruct o)
constructEntryProgressFraction val :: Double
val = String -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble "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
#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 :: o -> m Double
getEntryProgressPulseStep obj :: o
obj = IO Double -> m Double
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
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj "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 :: o -> Double -> m ()
setEntryProgressPulseStep obj :: o
obj val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj "progress-pulse-step" Double
val

-- | Construct a `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) => Double -> IO (GValueConstruct o)
constructEntryProgressPulseStep :: Double -> IO (GValueConstruct o)
constructEntryProgressPulseStep val :: Double
val = String -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble "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
#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 :: o -> m Int32
getEntryScrollOffset obj :: o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj "scroll-offset"

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m Bool
getEntrySecondaryIconActivatable obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "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 :: o -> Bool -> m ()
setEntrySecondaryIconActivatable obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "secondary-icon-activatable" Bool
val

-- | Construct a `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) => Bool -> IO (GValueConstruct o)
constructEntrySecondaryIconActivatable :: Bool -> IO (GValueConstruct o)
constructEntrySecondaryIconActivatable val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "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
#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 :: o -> m (Maybe Icon)
getEntrySecondaryIconGicon obj :: o
obj = IO (Maybe Icon) -> m (Maybe Icon)
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
$ 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 "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 :: o -> a -> m ()
setEntrySecondaryIconGicon obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "secondary-icon-gicon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `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, Gio.Icon.IsIcon a) => a -> IO (GValueConstruct o)
constructEntrySecondaryIconGicon :: a -> IO (GValueConstruct o)
constructEntrySecondaryIconGicon val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "secondary-icon-gicon" (a -> Maybe a
forall a. a -> Maybe a
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 :: o -> m ()
clearEntrySecondaryIconGicon obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Icon -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "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
#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 :: o -> m (Maybe Text)
getEntrySecondaryIconName obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setEntrySecondaryIconName obj :: o
obj val :: Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "secondary-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `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) => T.Text -> IO (GValueConstruct o)
constructEntrySecondaryIconName :: Text -> IO (GValueConstruct o)
constructEntrySecondaryIconName val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "secondary-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
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 :: o -> m ()
clearEntrySecondaryIconName obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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
#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 :: o -> m (Maybe Paintable)
getEntrySecondaryIconPaintable obj :: o
obj = IO (Maybe Paintable) -> m (Maybe Paintable)
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
$ 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 "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 :: o -> a -> m ()
setEntrySecondaryIconPaintable obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "secondary-icon-paintable" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `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, Gdk.Paintable.IsPaintable a) => a -> IO (GValueConstruct o)
constructEntrySecondaryIconPaintable :: a -> IO (GValueConstruct o)
constructEntrySecondaryIconPaintable val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "secondary-icon-paintable" (a -> Maybe a
forall a. a -> Maybe a
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 :: o -> m ()
clearEntrySecondaryIconPaintable obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Paintable -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "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
#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 :: o -> m Bool
getEntrySecondaryIconSensitive obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "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 :: o -> Bool -> m ()
setEntrySecondaryIconSensitive obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "secondary-icon-sensitive" Bool
val

-- | Construct a `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) => Bool -> IO (GValueConstruct o)
constructEntrySecondaryIconSensitive :: Bool -> IO (GValueConstruct o)
constructEntrySecondaryIconSensitive val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "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
#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 :: o -> m ImageType
getEntrySecondaryIconStorageType obj :: o
obj = IO ImageType -> m ImageType
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
$ o -> String -> IO ImageType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "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
#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 :: o -> m (Maybe Text)
getEntrySecondaryIconTooltipMarkup obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setEntrySecondaryIconTooltipMarkup obj :: o
obj val :: Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "secondary-icon-tooltip-markup" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `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) => T.Text -> IO (GValueConstruct o)
constructEntrySecondaryIconTooltipMarkup :: Text -> IO (GValueConstruct o)
constructEntrySecondaryIconTooltipMarkup val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "secondary-icon-tooltip-markup" (Text -> Maybe Text
forall a. a -> Maybe a
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 :: o -> m ()
clearEntrySecondaryIconTooltipMarkup obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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
#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 :: o -> m (Maybe Text)
getEntrySecondaryIconTooltipText obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setEntrySecondaryIconTooltipText obj :: o
obj val :: Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "secondary-icon-tooltip-text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `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) => T.Text -> IO (GValueConstruct o)
constructEntrySecondaryIconTooltipText :: Text -> IO (GValueConstruct o)
constructEntrySecondaryIconTooltipText val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "secondary-icon-tooltip-text" (Text -> Maybe Text
forall a. a -> Maybe a
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 :: o -> m ()
clearEntrySecondaryIconTooltipText obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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
#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 :: o -> m Bool
getEntryShowEmojiIcon obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "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 :: o -> Bool -> m ()
setEntryShowEmojiIcon obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "show-emoji-icon" Bool
val

-- | Construct a `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) => Bool -> IO (GValueConstruct o)
constructEntryShowEmojiIcon :: Bool -> IO (GValueConstruct o)
constructEntryShowEmojiIcon val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "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
#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 :: o -> m (Maybe TabArray)
getEntryTabs obj :: o
obj = IO (Maybe TabArray) -> m (Maybe TabArray)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TabArray) -> m (Maybe TabArray))
-> IO (Maybe TabArray) -> m (Maybe TabArray)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr TabArray -> TabArray)
-> IO (Maybe TabArray)
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj "tabs" ManagedPtr TabArray -> TabArray
Pango.TabArray.TabArray

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

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m Word32
getEntryTextLength obj :: o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj "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
#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 :: o -> m Bool
getEntryTruncateMultiline obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "truncate-multiline"

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#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 :: o -> m Bool
getEntryVisibility obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "visibility"

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

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

#if defined(ENABLE_OVERLOADING)
data 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
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Entry
type instance O.AttributeList Entry = EntryAttributeList
type EntryAttributeList = ('[ '("activatesDefault", EntryActivatesDefaultPropertyInfo), '("attributes", EntryAttributesPropertyInfo), '("buffer", EntryBufferPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("completion", EntryCompletionPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("cursorPosition", Gtk.Editable.EditableCursorPositionPropertyInfo), '("editable", Gtk.Editable.EditableEditablePropertyInfo), '("editingCanceled", Gtk.CellEditable.CellEditableEditingCanceledPropertyInfo), '("enableEmojiCompletion", EntryEnableEmojiCompletionPropertyInfo), '("expand", Gtk.Widget.WidgetExpandPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("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), '("isFocus", Gtk.Widget.WidgetIsFocusPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("margin", Gtk.Widget.WidgetMarginPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("maxLength", 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), '("populateAll", EntryPopulateAllPropertyInfo), '("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), '("surface", Gtk.Widget.WidgetSurfacePropertyInfo), '("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, *)])
#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

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

entryPopulateAll :: AttrLabelProxy "populateAll"
entryPopulateAll = 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 = ('[ '("accelClosuresChanged", Gtk.Widget.WidgetAccelClosuresChangedSignalInfo), '("activate", EntryActivateSignalInfo), '("canActivateAccel", Gtk.Widget.WidgetCanActivateAccelSignalInfo), '("changed", Gtk.Editable.EditableChangedSignalInfo), '("deleteText", Gtk.Editable.EditableDeleteTextSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("dragBegin", Gtk.Widget.WidgetDragBeginSignalInfo), '("dragDataDelete", Gtk.Widget.WidgetDragDataDeleteSignalInfo), '("dragDataGet", Gtk.Widget.WidgetDragDataGetSignalInfo), '("dragDataReceived", Gtk.Widget.WidgetDragDataReceivedSignalInfo), '("dragDrop", Gtk.Widget.WidgetDragDropSignalInfo), '("dragEnd", Gtk.Widget.WidgetDragEndSignalInfo), '("dragFailed", Gtk.Widget.WidgetDragFailedSignalInfo), '("dragLeave", Gtk.Widget.WidgetDragLeaveSignalInfo), '("dragMotion", Gtk.Widget.WidgetDragMotionSignalInfo), '("editingDone", Gtk.CellEditable.CellEditableEditingDoneSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("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), '("popupMenu", Gtk.Widget.WidgetPopupMenuSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("removeWidget", Gtk.CellEditable.CellEditableRemoveWidgetSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("sizeAllocate", Gtk.Widget.WidgetSizeAllocateSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("styleUpdated", Gtk.Widget.WidgetStyleUpdatedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#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 t'GI.Gtk.Objects.Entry.Entry'.
entryNew :: m Entry
entryNew  = IO Entry -> m Entry
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
    Ptr Entry
result <- IO (Ptr Entry)
gtk_entry_new
    Text -> Ptr Entry -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "entryNew" Ptr Entry
result
    Entry
result' <- ((ManagedPtr Entry -> Entry) -> Ptr Entry -> IO Entry
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Entry -> Entry
Entry) Ptr Entry
result
    Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry
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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'.
    -> m Entry
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Entry.Entry'
entryNewWithBuffer :: a -> m Entry
entryNewWithBuffer buffer :: a
buffer = IO Entry -> m Entry
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
    Ptr EntryBuffer
buffer' <- a -> IO (Ptr EntryBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr Entry
result <- Ptr EntryBuffer -> IO (Ptr Entry)
gtk_entry_new_with_buffer Ptr EntryBuffer
buffer'
    Text -> Ptr Entry -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "entryNewWithBuffer" Ptr Entry
result
    Entry
result' <- ((ManagedPtr Entry -> Entry) -> Ptr Entry -> IO Entry
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Entry -> Entry
Entry) Ptr Entry
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry
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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the entry will activate the default widget
entryGetActivatesDefault :: a -> m Bool
entryGetActivatesDefault entry :: a
entry = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CInt
result <- Ptr Entry -> IO CInt
gtk_entry_get_activates_default Ptr Entry
entry'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetActivatesDefaultMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEntry a) => O.MethodInfo EntryGetActivatesDefaultMethodInfo a signature where
    overloadedMethod = 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
--           , 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'.
entryGetAlignment ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m Float
    -- ^ __Returns:__ the alignment
entryGetAlignment :: a -> m Float
entryGetAlignment entry :: a
entry = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CFloat
result <- Ptr Entry -> IO CFloat
gtk_entry_get_alignment Ptr Entry
entry'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetAlignmentMethodInfo
instance (signature ~ (m Float), MonadIO m, IsEntry a) => O.MethodInfo EntryGetAlignmentMethodInfo a signature where
    overloadedMethod = 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
--           , 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 that was set on the entry using
-- 'GI.Gtk.Objects.Entry.entrySetAttributes', if any.
entryGetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m (Maybe Pango.AttrList.AttrList)
    -- ^ __Returns:__ the attribute list, or 'P.Nothing'
    --     if none was set.
entryGetAttributes :: a -> m (Maybe AttrList)
entryGetAttributes entry :: a
entry = IO (Maybe AttrList) -> m (Maybe AttrList)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AttrList) -> m (Maybe AttrList))
-> IO (Maybe AttrList) -> m (Maybe AttrList)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr AttrList
result <- Ptr Entry -> IO (Ptr AttrList)
gtk_entry_get_attributes Ptr Entry
entry'
    Maybe AttrList
maybeResult <- Ptr AttrList
-> (Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr AttrList
result ((Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList))
-> (Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr AttrList
result' -> do
        AttrList
result'' <- ((ManagedPtr AttrList -> AttrList) -> Ptr AttrList -> IO AttrList
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr AttrList -> AttrList
Pango.AttrList.AttrList) Ptr AttrList
result'
        AttrList -> IO AttrList
forall (m :: * -> *) a. Monad m => a -> m a
return AttrList
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe AttrList -> IO (Maybe AttrList)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AttrList
maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetAttributesMethodInfo
instance (signature ~ (m (Maybe Pango.AttrList.AttrList)), MonadIO m, IsEntry a) => O.MethodInfo EntryGetAttributesMethodInfo a signature where
    overloadedMethod = 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
--           , 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 t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' object which holds the text for
-- this widget.
entryGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m Gtk.EntryBuffer.EntryBuffer
    -- ^ __Returns:__ A t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' object.
entryGetBuffer :: a -> m EntryBuffer
entryGetBuffer entry :: a
entry = IO EntryBuffer -> m EntryBuffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntryBuffer -> m EntryBuffer)
-> IO EntryBuffer -> m EntryBuffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr EntryBuffer
result <- Ptr Entry -> IO (Ptr EntryBuffer)
gtk_entry_get_buffer Ptr Entry
entry'
    Text -> Ptr EntryBuffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "entryGetBuffer" Ptr EntryBuffer
result
    EntryBuffer
result' <- ((ManagedPtr EntryBuffer -> EntryBuffer)
-> Ptr EntryBuffer -> IO EntryBuffer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr EntryBuffer -> EntryBuffer
Gtk.EntryBuffer.EntryBuffer) Ptr EntryBuffer
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    EntryBuffer -> IO EntryBuffer
forall (m :: * -> *) a. Monad m => a -> m a
return EntryBuffer
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetBufferMethodInfo
instance (signature ~ (m Gtk.EntryBuffer.EntryBuffer), MonadIO m, IsEntry a) => O.MethodInfo EntryGetBufferMethodInfo a signature where
    overloadedMethod = 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
--           , 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)

-- | Returns the auxiliary completion object currently in use by /@entry@/.
entryGetCompletion ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A t'GI.Gtk.Objects.Entry.Entry'
    -> m Gtk.EntryCompletion.EntryCompletion
    -- ^ __Returns:__ The auxiliary completion object currently
    --     in use by /@entry@/.
entryGetCompletion :: a -> m EntryCompletion
entryGetCompletion entry :: a
entry = IO EntryCompletion -> m EntryCompletion
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntryCompletion -> m EntryCompletion)
-> IO EntryCompletion -> m EntryCompletion
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr EntryCompletion
result <- Ptr Entry -> IO (Ptr EntryCompletion)
gtk_entry_get_completion Ptr Entry
entry'
    Text -> Ptr EntryCompletion -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "entryGetCompletion" Ptr EntryCompletion
result
    EntryCompletion
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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    EntryCompletion -> IO EntryCompletion
forall (m :: * -> *) a. Monad m => a -> m a
return EntryCompletion
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetCompletionMethodInfo
instance (signature ~ (m Gtk.EntryCompletion.EntryCompletion), MonadIO m, IsEntry a) => O.MethodInfo EntryGetCompletionMethodInfo a signature where
    overloadedMethod = 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
--           , 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.
-- 
-- This function is meant to be used in a [dragDataGet]("GI.Gtk.Objects.Widget#signal:dragDataGet")
-- callback.
entryGetCurrentIconDragSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m Int32
    -- ^ __Returns:__ index of the icon which is the source of the current
    --          DND operation, or -1.
entryGetCurrentIconDragSource :: a -> m Int32
entryGetCurrentIconDragSource entry :: a
entry = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Int32
result <- Ptr Entry -> IO Int32
gtk_entry_get_current_icon_drag_source Ptr Entry
entry'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

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

#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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> m Bool
    -- ^ __Returns:__ whether the entry has a beveled frame
entryGetHasFrame :: a -> m Bool
entryGetHasFrame entry :: a
entry = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CInt
result <- Ptr Entry -> IO CInt
gtk_entry_get_has_frame Ptr Entry
entry'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetHasFrameMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEntry a) => O.MethodInfo EntryGetHasFrameMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the icon is activatable.
entryGetIconActivatable :: a -> EntryIconPosition -> m Bool
entryGetIconActivatable entry :: a
entry iconPos :: EntryIconPosition
iconPos = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    CInt
result <- Ptr Entry -> CUInt -> IO CInt
gtk_entry_get_icon_activatable Ptr Entry
entry' CUInt
iconPos'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetIconActivatableMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m Bool), MonadIO m, IsEntry a) => O.MethodInfo EntryGetIconActivatableMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m (Gdk.Rectangle.Rectangle)
entryGetIconArea :: a -> EntryIconPosition -> m Rectangle
entryGetIconArea entry :: a
entry iconPos :: EntryIconPosition
iconPos = IO Rectangle -> m Rectangle
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
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    Ptr Rectangle
iconArea <- Int -> IO (Ptr Rectangle)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 16 :: IO (Ptr Gdk.Rectangle.Rectangle)
    Ptr Entry -> CUInt -> Ptr Rectangle -> IO ()
gtk_entry_get_icon_area Ptr Entry
entry' CUInt
iconPos' Ptr Rectangle
iconArea
    Rectangle
iconArea' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Gdk.Rectangle.Rectangle) Ptr Rectangle
iconArea
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
iconArea'

#if defined(ENABLE_OVERLOADING)
data EntryGetIconAreaMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Gdk.Rectangle.Rectangle)), MonadIO m, IsEntry a) => O.MethodInfo EntryGetIconAreaMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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 [queryTooltip]("GI.Gtk.Objects.Widget#signal:queryTooltip")
-- signal handler.
entryGetIconAtPos ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> 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 :: a -> Int32 -> Int32 -> m Int32
entryGetIconAtPos entry :: a
entry x :: Int32
x y :: Int32
y = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Int32
result <- Ptr Entry -> Int32 -> Int32 -> IO Int32
gtk_entry_get_icon_at_pos Ptr Entry
entry' Int32
x Int32
y
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data EntryGetIconAtPosMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Int32), MonadIO m, IsEntry a) => O.MethodInfo EntryGetIconAtPosMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gio.Interfaces.Icon.Icon' used for the icon, or 'P.Nothing' if there is
-- no icon or if the icon was set by some other method (e.g., by
-- paintable or icon name).
entryGetIconGicon ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m (Maybe Gio.Icon.Icon)
    -- ^ __Returns:__ A t'GI.Gio.Interfaces.Icon.Icon', or 'P.Nothing' if no icon is set
    --     or if the icon is not a t'GI.Gio.Interfaces.Icon.Icon'
entryGetIconGicon :: a -> EntryIconPosition -> m (Maybe Icon)
entryGetIconGicon entry :: a
entry iconPos :: EntryIconPosition
iconPos = IO (Maybe Icon) -> m (Maybe Icon)
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
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    Ptr Icon
result <- Ptr Entry -> CUInt -> IO (Ptr Icon)
gtk_entry_get_icon_gicon Ptr Entry
entry' CUInt
iconPos'
    Maybe Icon
maybeResult <- Ptr Icon -> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Icon
result ((Ptr Icon -> IO Icon) -> IO (Maybe Icon))
-> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Icon
result' -> do
        Icon
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'
        Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe Icon -> IO (Maybe Icon)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Icon
maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetIconGiconMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Maybe Gio.Icon.Icon)), MonadIO m, IsEntry a) => O.MethodInfo EntryGetIconGiconMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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, or 'P.Nothing' if there is
-- no icon or if the icon was set by some other method (e.g., by
-- paintable or gicon).
entryGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m (Maybe T.Text)
    -- ^ __Returns:__ An icon name, or 'P.Nothing' if no icon is set or if the icon
    --          wasn’t set from an icon name
entryGetIconName :: a -> EntryIconPosition -> m (Maybe Text)
entryGetIconName entry :: a
entry iconPos :: EntryIconPosition
iconPos = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    CString
result <- Ptr Entry -> CUInt -> IO CString
gtk_entry_get_icon_name Ptr Entry
entry' CUInt
iconPos'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetIconNameMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Maybe T.Text)), MonadIO m, IsEntry a) => O.MethodInfo EntryGetIconNameMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gdk.Interfaces.Paintable.Paintable' used for the icon.
-- 
-- If no t'GI.Gdk.Interfaces.Paintable.Paintable' was used for the icon, 'P.Nothing' is returned.
entryGetIconPaintable ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: A t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m (Maybe Gdk.Paintable.Paintable)
    -- ^ __Returns:__ A t'GI.Gdk.Interfaces.Paintable.Paintable', or 'P.Nothing' if no icon is
    --     set for this position or the icon set is not a t'GI.Gdk.Interfaces.Paintable.Paintable'.
entryGetIconPaintable :: a -> EntryIconPosition -> m (Maybe Paintable)
entryGetIconPaintable entry :: a
entry iconPos :: EntryIconPosition
iconPos = IO (Maybe Paintable) -> m (Maybe Paintable)
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
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    Ptr Paintable
result <- Ptr Entry -> CUInt -> IO (Ptr Paintable)
gtk_entry_get_icon_paintable Ptr Entry
entry' CUInt
iconPos'
    Maybe Paintable
maybeResult <- Ptr Paintable
-> (Ptr Paintable -> IO Paintable) -> IO (Maybe Paintable)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Paintable
result ((Ptr Paintable -> IO Paintable) -> IO (Maybe Paintable))
-> (Ptr Paintable -> IO Paintable) -> IO (Maybe Paintable)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Paintable
result' -> do
        Paintable
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'
        Paintable -> IO Paintable
forall (m :: * -> *) a. Monad m => a -> m a
return Paintable
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe Paintable -> IO (Maybe Paintable)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Paintable
maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetIconPaintableMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Maybe Gdk.Paintable.Paintable)), MonadIO m, IsEntry a) => O.MethodInfo EntryGetIconPaintableMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the icon is sensitive.
entryGetIconSensitive :: a -> EntryIconPosition -> m Bool
entryGetIconSensitive entry :: a
entry iconPos :: EntryIconPosition
iconPos = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    CInt
result <- Ptr Entry -> CUInt -> IO CInt
gtk_entry_get_icon_sensitive Ptr Entry
entry' CUInt
iconPos'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetIconSensitiveMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m Bool), MonadIO m, IsEntry a) => O.MethodInfo EntryGetIconSensitiveMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> m Gtk.Enums.ImageType
    -- ^ __Returns:__ image representation being used
entryGetIconStorageType :: a -> EntryIconPosition -> m ImageType
entryGetIconStorageType entry :: a
entry iconPos :: EntryIconPosition
iconPos = IO ImageType -> m ImageType
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
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    CUInt
result <- Ptr Entry -> CUInt -> IO CUInt
gtk_entry_get_icon_storage_type Ptr Entry
entry' CUInt
iconPos'
    let result' :: ImageType
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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    ImageType -> IO ImageType
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetIconStorageTypeMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m Gtk.Enums.ImageType), MonadIO m, IsEntry a) => O.MethodInfo EntryGetIconStorageTypeMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: the icon position
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the tooltip text, or 'P.Nothing'. Free the returned
    --     string with 'GI.GLib.Functions.free' when done.
entryGetIconTooltipMarkup :: a -> EntryIconPosition -> m (Maybe Text)
entryGetIconTooltipMarkup entry :: a
entry iconPos :: EntryIconPosition
iconPos = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    CString
result <- Ptr Entry -> CUInt -> IO CString
gtk_entry_get_icon_tooltip_markup Ptr Entry
entry' CUInt
iconPos'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetIconTooltipMarkupMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Maybe T.Text)), MonadIO m, IsEntry a) => O.MethodInfo EntryGetIconTooltipMarkupMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: the icon position
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the tooltip text, or 'P.Nothing'. Free the returned
    --     string with 'GI.GLib.Functions.free' when done.
entryGetIconTooltipText :: a -> EntryIconPosition -> m (Maybe Text)
entryGetIconTooltipText entry :: a
entry iconPos :: EntryIconPosition
iconPos = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    CString
result <- Ptr Entry -> CUInt -> IO CString
gtk_entry_get_icon_tooltip_text Ptr Entry
entry' CUInt
iconPos'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetIconTooltipTextMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> m (Maybe T.Text)), MonadIO m, IsEntry a) => O.MethodInfo EntryGetIconTooltipTextMethodInfo a signature where
    overloadedMethod = 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
--           , 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 value of the t'GI.Gtk.Objects.Entry.Entry':@/input-hints/@ property.
entryGetInputHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m [Gtk.Flags.InputHints]
entryGetInputHints :: a -> m [InputHints]
entryGetInputHints entry :: a
entry = IO [InputHints] -> m [InputHints]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [InputHints] -> m [InputHints])
-> IO [InputHints] -> m [InputHints]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CUInt
result <- Ptr Entry -> IO CUInt
gtk_entry_get_input_hints Ptr Entry
entry'
    let result' :: [InputHints]
result' = CUInt -> [InputHints]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    [InputHints] -> IO [InputHints]
forall (m :: * -> *) a. Monad m => a -> m a
return [InputHints]
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetInputHintsMethodInfo
instance (signature ~ (m [Gtk.Flags.InputHints]), MonadIO m, IsEntry a) => O.MethodInfo EntryGetInputHintsMethodInfo a signature where
    overloadedMethod = 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
--           , 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 value of the t'GI.Gtk.Objects.Entry.Entry':@/input-purpose/@ property.
entryGetInputPurpose ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m Gtk.Enums.InputPurpose
entryGetInputPurpose :: a -> m InputPurpose
entryGetInputPurpose entry :: a
entry = IO InputPurpose -> m InputPurpose
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputPurpose -> m InputPurpose)
-> IO InputPurpose -> m InputPurpose
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CUInt
result <- Ptr Entry -> IO CUInt
gtk_entry_get_input_purpose Ptr Entry
entry'
    let result' :: InputPurpose
result' = (Int -> InputPurpose
forall a. Enum a => Int -> a
toEnum (Int -> InputPurpose) -> (CUInt -> Int) -> CUInt -> InputPurpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    InputPurpose -> IO InputPurpose
forall (m :: * -> *) a. Monad m => a -> m a
return InputPurpose
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetInputPurposeMethodInfo
instance (signature ~ (m Gtk.Enums.InputPurpose), MonadIO m, IsEntry a) => O.MethodInfo EntryGetInputPurposeMethodInfo a signature where
    overloadedMethod = 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
--           , 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 real characters
-- for entries with visibility set to false. See 'GI.Gtk.Objects.Entry.entrySetInvisibleChar'.
entryGetInvisibleChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m Char
    -- ^ __Returns:__ the current invisible char, or 0, if the entry does not
    --               show invisible text at all.
entryGetInvisibleChar :: a -> m Char
entryGetInvisibleChar entry :: a
entry = IO Char -> m Char
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Char -> m Char) -> IO Char -> m Char
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CInt
result <- Ptr Entry -> IO CInt
gtk_entry_get_invisible_char Ptr Entry
entry'
    let result' :: Char
result' = (Int -> Char
chr (Int -> Char) -> (CInt -> Int) -> CInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Char -> IO Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetInvisibleCharMethodInfo
instance (signature ~ (m Char), MonadIO m, IsEntry a) => O.MethodInfo EntryGetInvisibleCharMethodInfo a signature where
    overloadedMethod = 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
--           , 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'.
-- 
-- This is equivalent to getting /@entry@/\'s t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' and
-- calling 'GI.Gtk.Objects.EntryBuffer.entryBufferGetMaxLength' on it.
entryGetMaxLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m Int32
    -- ^ __Returns:__ the maximum allowed number of characters
    --               in t'GI.Gtk.Objects.Entry.Entry', or 0 if there is no maximum.
entryGetMaxLength :: a -> m Int32
entryGetMaxLength entry :: a
entry = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Int32
result <- Ptr Entry -> IO Int32
gtk_entry_get_max_length Ptr Entry
entry'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data EntryGetMaxLengthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsEntry a) => O.MethodInfo EntryGetMaxLengthMethodInfo a signature where
    overloadedMethod = 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
--           , 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 the value set by 'GI.Gtk.Objects.Entry.entrySetOverwriteMode'.
entryGetOverwriteMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m Bool
    -- ^ __Returns:__ whether the text is overwritten when typing.
entryGetOverwriteMode :: a -> m Bool
entryGetOverwriteMode entry :: a
entry = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CInt
result <- Ptr Entry -> IO CInt
gtk_entry_get_overwrite_mode Ptr Entry
entry'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetOverwriteModeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEntry a) => O.MethodInfo EntryGetOverwriteModeMethodInfo a signature where
    overloadedMethod = 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> 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 :: a -> m (Maybe Text)
entryGetPlaceholderText entry :: a
entry = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CString
result <- Ptr Entry -> IO CString
gtk_entry_get_placeholder_text Ptr Entry
entry'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetPlaceholderTextMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsEntry a) => O.MethodInfo EntryGetPlaceholderTextMethodInfo a signature where
    overloadedMethod = 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> m Double
    -- ^ __Returns:__ a fraction from 0.0 to 1.0
entryGetProgressFraction :: a -> m Double
entryGetProgressFraction entry :: a
entry = IO Double -> m Double
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
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CDouble
result <- Ptr Entry -> IO CDouble
gtk_entry_get_progress_fraction Ptr Entry
entry'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetProgressFractionMethodInfo
instance (signature ~ (m Double), MonadIO m, IsEntry a) => O.MethodInfo EntryGetProgressFractionMethodInfo a signature where
    overloadedMethod = 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> m Double
    -- ^ __Returns:__ a fraction from 0.0 to 1.0
entryGetProgressPulseStep :: a -> m Double
entryGetProgressPulseStep entry :: a
entry = IO Double -> m Double
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
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CDouble
result <- Ptr Entry -> IO CDouble
gtk_entry_get_progress_pulse_step Ptr Entry
entry'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetProgressPulseStepMethodInfo
instance (signature ~ (m Double), MonadIO m, IsEntry a) => O.MethodInfo EntryGetProgressPulseStepMethodInfo a signature where
    overloadedMethod = 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
--           , 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 that were set on the entry using 'GI.Gtk.Objects.Entry.entrySetTabs', if
-- any.
entryGetTabs ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m (Maybe Pango.TabArray.TabArray)
    -- ^ __Returns:__ the tabstops, or 'P.Nothing' if none was set.
entryGetTabs :: a -> m (Maybe TabArray)
entryGetTabs entry :: a
entry = IO (Maybe TabArray) -> m (Maybe TabArray)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TabArray) -> m (Maybe TabArray))
-> IO (Maybe TabArray) -> m (Maybe TabArray)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr TabArray
result <- Ptr Entry -> IO (Ptr TabArray)
gtk_entry_get_tabs Ptr Entry
entry'
    Maybe TabArray
maybeResult <- Ptr TabArray
-> (Ptr TabArray -> IO TabArray) -> IO (Maybe TabArray)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TabArray
result ((Ptr TabArray -> IO TabArray) -> IO (Maybe TabArray))
-> (Ptr TabArray -> IO TabArray) -> IO (Maybe TabArray)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr TabArray
result' -> do
        TabArray
result'' <- ((ManagedPtr TabArray -> TabArray) -> Ptr TabArray -> IO TabArray
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TabArray -> TabArray
Pango.TabArray.TabArray) Ptr TabArray
result'
        TabArray -> IO TabArray
forall (m :: * -> *) a. Monad m => a -> m a
return TabArray
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe TabArray -> IO (Maybe TabArray)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TabArray
maybeResult

#if defined(ENABLE_OVERLOADING)
data EntryGetTabsMethodInfo
instance (signature ~ (m (Maybe Pango.TabArray.TabArray)), MonadIO m, IsEntry a) => O.MethodInfo EntryGetTabsMethodInfo a signature where
    overloadedMethod = 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
--           , 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 t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' and
-- calling 'GI.Gtk.Objects.EntryBuffer.entryBufferGetLength' on it.
entryGetTextLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m Word16
    -- ^ __Returns:__ the current number of characters
    --               in t'GI.Gtk.Objects.Entry.Entry', or 0 if there are none.
entryGetTextLength :: a -> m Word16
entryGetTextLength entry :: a
entry = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Word16
result <- Ptr Entry -> IO Word16
gtk_entry_get_text_length Ptr Entry
entry'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data EntryGetTextLengthMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsEntry a) => O.MethodInfo EntryGetTextLengthMethodInfo a signature where
    overloadedMethod = 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the text is currently visible
entryGetVisibility :: a -> m Bool
entryGetVisibility entry :: a
entry = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CInt
result <- Ptr Entry -> IO CInt
gtk_entry_get_visibility Ptr Entry
entry'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EntryGetVisibilityMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEntry a) => O.MethodInfo EntryGetVisibilityMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- 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 ()

-- | 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 t'GI.Gtk.Objects.Entry.Entry'
    -> m ()
entryGrabFocusWithoutSelecting :: a -> m ()
entryGrabFocusWithoutSelecting entry :: a
entry = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr Entry -> IO ()
gtk_entry_grab_focus_without_selecting Ptr Entry
entry'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntryGrabFocusWithoutSelectingMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEntry a) => O.MethodInfo EntryGrabFocusWithoutSelectingMethodInfo a signature where
    overloadedMethod = 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> m ()
entryProgressPulse :: a -> m ()
entryProgressPulse entry :: a
entry = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr Entry -> IO ()
gtk_entry_progress_pulse Ptr Entry
entry'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntryProgressPulseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEntry a) => O.MethodInfo EntryProgressPulseMethodInfo a signature where
    overloadedMethod = 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> m ()
entryResetImContext :: a -> m ()
entryResetImContext entry :: a
entry = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr Entry -> IO ()
gtk_entry_reset_im_context Ptr Entry
entry'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntryResetImContextMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEntry a) => O.MethodInfo EntryResetImContextMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 ()

-- | If /@setting@/ is 'P.True', pressing Enter in the /@entry@/ will activate the default
-- widget for the window containing the entry. This usually means that
-- the dialog box 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Bool
    -- ^ /@setting@/: 'P.True' to activate window’s default widget on Enter keypress
    -> m ()
entrySetActivatesDefault :: a -> Bool -> m ()
entrySetActivatesDefault entry :: a
entry setting :: Bool
setting = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let setting' :: CInt
setting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
setting
    Ptr Entry -> CInt -> IO ()
gtk_entry_set_activates_default Ptr Entry
entry' CInt
setting'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetActivatesDefaultMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetActivatesDefaultMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "xalign"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The horizontal alignment, from 0 (left) to 1 (right).\n         Reversed for RTL layouts"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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.
entrySetAlignment ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> Float
    -- ^ /@xalign@/: The horizontal alignment, from 0 (left) to 1 (right).
    --          Reversed for RTL layouts
    -> m ()
entrySetAlignment :: a -> Float -> m ()
entrySetAlignment entry :: a
entry xalign :: Float
xalign = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let xalign' :: CFloat
xalign' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign
    Ptr Entry -> CFloat -> IO ()
gtk_entry_set_alignment Ptr Entry
entry' CFloat
xalign'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetAlignmentMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetAlignmentMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attrs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoAttrList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 t'GI.Pango.Structs.AttrList.AttrList'; the attributes in the list are applied to the
-- entry text.
entrySetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> Pango.AttrList.AttrList
    -- ^ /@attrs@/: a t'GI.Pango.Structs.AttrList.AttrList'
    -> m ()
entrySetAttributes :: a -> AttrList -> m ()
entrySetAttributes entry :: a
entry attrs :: AttrList
attrs = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr AttrList
attrs' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
attrs
    Ptr Entry -> Ptr AttrList -> IO ()
gtk_entry_set_attributes Ptr Entry
entry' Ptr AttrList
attrs'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
attrs
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetAttributesMethodInfo
instance (signature ~ (Pango.AttrList.AttrList -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetAttributesMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkEntryBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' object which holds the text for
-- this widget.
entrySetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a, Gtk.EntryBuffer.IsEntryBuffer b) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> b
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.EntryBuffer.EntryBuffer'
    -> m ()
entrySetBuffer :: a -> b -> m ()
entrySetBuffer entry :: a
entry buffer :: b
buffer = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr EntryBuffer
buffer' <- b -> IO (Ptr EntryBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
buffer
    Ptr Entry -> Ptr EntryBuffer -> IO ()
gtk_entry_set_buffer Ptr Entry
entry' Ptr EntryBuffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
buffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetBufferMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsEntry a, Gtk.EntryBuffer.IsEntryBuffer b) => O.MethodInfo EntrySetBufferMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "completion"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "EntryCompletion" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GtkEntryCompletion or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 ()

-- | 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 t'GI.Gtk.Objects.EntryCompletion.EntryCompletion' 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Maybe (b)
    -- ^ /@completion@/: The t'GI.Gtk.Objects.EntryCompletion.EntryCompletion' or 'P.Nothing'
    -> m ()
entrySetCompletion :: a -> Maybe b -> m ()
entrySetCompletion entry :: a
entry completion :: Maybe b
completion = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr EntryCompletion
maybeCompletion <- case Maybe b
completion of
        Nothing -> Ptr EntryCompletion -> IO (Ptr EntryCompletion)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr EntryCompletion
forall a. Ptr a
nullPtr
        Just jCompletion :: b
jCompletion -> do
            Ptr EntryCompletion
jCompletion' <- b -> IO (Ptr EntryCompletion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCompletion
            Ptr EntryCompletion -> IO (Ptr EntryCompletion)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr EntryCompletion
jCompletion'
    Ptr Entry -> Ptr EntryCompletion -> IO ()
gtk_entry_set_completion Ptr Entry
entry' Ptr EntryCompletion
maybeCompletion
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
completion b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#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
--           , 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Bool
    -- ^ /@setting@/: new value
    -> m ()
entrySetHasFrame :: a -> Bool -> m ()
entrySetHasFrame entry :: a
entry setting :: Bool
setting = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let setting' :: CInt
setting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
setting
    Ptr Entry -> CInt -> IO ()
gtk_entry_set_has_frame Ptr Entry
entry' CInt
setting'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetHasFrameMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetHasFrameMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> Bool
    -- ^ /@activatable@/: 'P.True' if the icon should be activatable
    -> m ()
entrySetIconActivatable :: a -> EntryIconPosition -> Bool -> m ()
entrySetIconActivatable entry :: a
entry iconPos :: EntryIconPosition
iconPos activatable :: Bool
activatable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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' :: CInt
activatable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
activatable
    Ptr Entry -> CUInt -> CInt -> IO ()
gtk_entry_set_icon_activatable Ptr Entry
entry' CUInt
iconPos' CInt
activatable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconActivatableMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Bool -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetIconActivatableMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "formats"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the targets (data formats) in which the data can be provided"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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.ContentFormats.ContentFormats -> -- formats : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    CUInt ->                                -- actions : TInterface (Name {namespace = "Gdk", name = "DragAction"})
    IO ()

-- | Sets up the icon at the given position so that GTK+ will start a drag
-- operation when the user clicks and drags the icon.
-- 
-- To handle the drag operation, you need to connect to the usual
-- [dragDataGet]("GI.Gtk.Objects.Widget#signal:dragDataGet") (or possibly [dragDataDelete]("GI.Gtk.Objects.Widget#signal:dragDataDelete"))
-- signal, and use 'GI.Gtk.Objects.Entry.entryGetCurrentIconDragSource' in
-- your signal handler to find out if the drag was started from
-- an icon.
-- 
-- By default, GTK+ uses the icon as the drag icon. You can use the
-- [dragBegin]("GI.Gtk.Objects.Widget#signal:dragBegin") signal to set a different icon. Note that you
-- have to use @/g_signal_connect_after()/@ to ensure that your signal handler
-- gets executed after the default handler.
entrySetIconDragSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: icon position
    -> Gdk.ContentFormats.ContentFormats
    -- ^ /@formats@/: the targets (data formats) in which the data can be provided
    -> [Gdk.Flags.DragAction]
    -- ^ /@actions@/: a bitmask of the allowed drag actions
    -> m ()
entrySetIconDragSource :: a -> EntryIconPosition -> ContentFormats -> [DragAction] -> m ()
entrySetIconDragSource entry :: a
entry iconPos :: EntryIconPosition
iconPos formats :: ContentFormats
formats actions :: [DragAction]
actions = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    Ptr ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    let actions' :: CUInt
actions' = [DragAction] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DragAction]
actions
    Ptr Entry -> CUInt -> Ptr ContentFormats -> CUInt -> IO ()
gtk_entry_set_icon_drag_source Ptr Entry
entry' CUInt
iconPos' Ptr ContentFormats
formats' CUInt
actions'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconDragSourceMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Gdk.ContentFormats.ContentFormats -> [Gdk.Flags.DragAction] -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetIconDragSourceMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The icon to set, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: The position at which to set the icon
    -> Maybe (b)
    -- ^ /@icon@/: The icon to set, or 'P.Nothing'
    -> m ()
entrySetIconFromGicon :: a -> EntryIconPosition -> Maybe b -> m ()
entrySetIconFromGicon entry :: a
entry iconPos :: EntryIconPosition
iconPos icon :: Maybe b
icon = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    Ptr Icon
maybeIcon <- case Maybe b
icon of
        Nothing -> Ptr Icon -> IO (Ptr Icon)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
forall a. Ptr a
nullPtr
        Just jIcon :: b
jIcon -> do
            Ptr Icon
jIcon' <- b -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jIcon
            Ptr Icon -> IO (Ptr Icon)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
jIcon'
    Ptr Entry -> CUInt -> Ptr Icon -> IO ()
gtk_entry_set_icon_from_gicon Ptr Entry
entry' CUInt
iconPos' Ptr Icon
maybeIcon
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
icon b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconFromGiconMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Maybe (b) -> m ()), MonadIO m, IsEntry a, Gio.Icon.IsIcon b) => O.MethodInfo EntrySetIconFromGiconMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An icon name, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: The position at which to set the icon
    -> Maybe (T.Text)
    -- ^ /@iconName@/: An icon name, or 'P.Nothing'
    -> m ()
entrySetIconFromIconName :: a -> EntryIconPosition -> Maybe Text -> m ()
entrySetIconFromIconName entry :: a
entry iconPos :: EntryIconPosition
iconPos iconName :: Maybe Text
iconName = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    CString
maybeIconName <- case Maybe Text
iconName of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jIconName :: Text
jIconName -> do
            CString
jIconName' <- Text -> IO CString
textToCString Text
jIconName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIconName'
    Ptr Entry -> CUInt -> CString -> IO ()
gtk_entry_set_icon_from_icon_name Ptr Entry
entry' CUInt
iconPos' CString
maybeIconName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIconName
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconFromIconNameMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Maybe (T.Text) -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetIconFromIconNameMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GdkPaintable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 t'GI.Gdk.Interfaces.Paintable.Paintable'
-- 
-- 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> Maybe (b)
    -- ^ /@paintable@/: A t'GI.Gdk.Interfaces.Paintable.Paintable', or 'P.Nothing'
    -> m ()
entrySetIconFromPaintable :: a -> EntryIconPosition -> Maybe b -> m ()
entrySetIconFromPaintable entry :: a
entry iconPos :: EntryIconPosition
iconPos paintable :: Maybe b
paintable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    Ptr Paintable
maybePaintable <- case Maybe b
paintable of
        Nothing -> Ptr Paintable -> IO (Ptr Paintable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Paintable
forall a. Ptr a
nullPtr
        Just jPaintable :: b
jPaintable -> do
            Ptr Paintable
jPaintable' <- b -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPaintable
            Ptr Paintable -> IO (Ptr Paintable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Paintable
jPaintable'
    Ptr Entry -> CUInt -> Ptr Paintable -> IO ()
gtk_entry_set_icon_from_paintable Ptr Entry
entry' CUInt
iconPos' Ptr Paintable
maybePaintable
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
paintable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconFromPaintableMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Maybe (b) -> m ()), MonadIO m, IsEntry a, Gdk.Paintable.IsPaintable b) => O.MethodInfo EntrySetIconFromPaintableMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: Icon position
    -> Bool
    -- ^ /@sensitive@/: Specifies whether the icon should appear
    --             sensitive or insensitive
    -> m ()
entrySetIconSensitive :: a -> EntryIconPosition -> Bool -> m ()
entrySetIconSensitive entry :: a
entry iconPos :: EntryIconPosition
iconPos sensitive :: Bool
sensitive = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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' :: CInt
sensitive' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
sensitive
    Ptr Entry -> CUInt -> CInt -> IO ()
gtk_entry_set_icon_sensitive Ptr Entry
entry' CUInt
iconPos' CInt
sensitive'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconSensitiveMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Bool -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetIconSensitiveMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tooltip"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the contents of the tooltip for the icon, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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
-- the [Pango text markup language][PangoMarkupFormat].
-- 
-- 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: the icon position
    -> Maybe (T.Text)
    -- ^ /@tooltip@/: the contents of the tooltip for the icon, or 'P.Nothing'
    -> m ()
entrySetIconTooltipMarkup :: a -> EntryIconPosition -> Maybe Text -> m ()
entrySetIconTooltipMarkup entry :: a
entry iconPos :: EntryIconPosition
iconPos tooltip :: Maybe Text
tooltip = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    CString
maybeTooltip <- case Maybe Text
tooltip of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jTooltip :: Text
jTooltip -> do
            CString
jTooltip' <- Text -> IO CString
textToCString Text
jTooltip
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTooltip'
    Ptr Entry -> CUInt -> CString -> IO ()
gtk_entry_set_icon_tooltip_markup Ptr Entry
entry' CUInt
iconPos' CString
maybeTooltip
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTooltip
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconTooltipMarkupMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Maybe (T.Text) -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetIconTooltipMarkupMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tooltip"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the contents of the tooltip for the icon, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 GtkWidget:has-tooltip to 'P.False',
-- which suppresses icon tooltips too. You can resolve this by then calling
-- 'GI.Gtk.Objects.Widget.widgetSetHasTooltip' to set GtkWidget:has-tooltip 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.EntryIconPosition
    -- ^ /@iconPos@/: the icon position
    -> Maybe (T.Text)
    -- ^ /@tooltip@/: the contents of the tooltip for the icon, or 'P.Nothing'
    -> m ()
entrySetIconTooltipText :: a -> EntryIconPosition -> Maybe Text -> m ()
entrySetIconTooltipText entry :: a
entry iconPos :: EntryIconPosition
iconPos tooltip :: Maybe Text
tooltip = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let iconPos' :: CUInt
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
    CString
maybeTooltip <- case Maybe Text
tooltip of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jTooltip :: Text
jTooltip -> do
            CString
jTooltip' <- Text -> IO CString
textToCString Text
jTooltip
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTooltip'
    Ptr Entry -> CUInt -> CString -> IO ()
gtk_entry_set_icon_tooltip_text Ptr Entry
entry' CUInt
iconPos' CString
maybeTooltip
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTooltip
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetIconTooltipTextMethodInfo
instance (signature ~ (Gtk.Enums.EntryIconPosition -> Maybe (T.Text) -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetIconTooltipTextMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hints"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "InputHints" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the hints" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 ()

-- | Sets the t'GI.Gtk.Objects.Entry.Entry':@/input-hints/@ property, which
-- allows input methods to fine-tune their behaviour.
entrySetInputHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> [Gtk.Flags.InputHints]
    -- ^ /@hints@/: the hints
    -> m ()
entrySetInputHints :: a -> [InputHints] -> m ()
entrySetInputHints entry :: a
entry hints :: [InputHints]
hints = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let hints' :: CUInt
hints' = [InputHints] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [InputHints]
hints
    Ptr Entry -> CUInt -> IO ()
gtk_entry_set_input_hints Ptr Entry
entry' CUInt
hints'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetInputHintsMethodInfo
instance (signature ~ ([Gtk.Flags.InputHints] -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetInputHintsMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "purpose"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "InputPurpose" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the purpose" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 t'GI.Gtk.Objects.Entry.Entry':@/input-purpose/@ property which
-- can be used by on-screen keyboards and other input
-- methods to adjust their behaviour.
entrySetInputPurpose ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> Gtk.Enums.InputPurpose
    -- ^ /@purpose@/: the purpose
    -> m ()
entrySetInputPurpose :: a -> InputPurpose -> m ()
entrySetInputPurpose entry :: a
entry purpose :: InputPurpose
purpose = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let purpose' :: CUInt
purpose' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (InputPurpose -> Int) -> InputPurpose -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputPurpose -> Int
forall a. Enum a => a -> Int
fromEnum) InputPurpose
purpose
    Ptr Entry -> CUInt -> IO ()
gtk_entry_set_input_purpose Ptr Entry
entry' CUInt
purpose'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetInputPurposeMethodInfo
instance (signature ~ (Gtk.Enums.InputPurpose -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetInputPurposeMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ch"
--           , argType = TBasicType TUniChar
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a Unicode character"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

#if defined(ENABLE_OVERLOADING)
data EntrySetInvisibleCharMethodInfo
instance (signature ~ (Char -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetInvisibleCharMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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.
-- 
-- This is equivalent to getting /@entry@/\'s t'GI.Gtk.Objects.EntryBuffer.EntryBuffer' and
-- calling 'GI.Gtk.Objects.EntryBuffer.entryBufferSetMaxLength' on it.
-- ]|
entrySetMaxLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> 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 :: a -> Int32 -> m ()
entrySetMaxLength entry :: a
entry max :: Int32
max = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr Entry -> Int32 -> IO ()
gtk_entry_set_max_length Ptr Entry
entry' Int32
max
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetMaxLengthMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetMaxLengthMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "overwrite"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 t'GI.Gtk.Objects.Entry.Entry'.
entrySetOverwriteMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> Bool
    -- ^ /@overwrite@/: new value
    -> m ()
entrySetOverwriteMode :: a -> Bool -> m ()
entrySetOverwriteMode entry :: a
entry overwrite :: Bool
overwrite = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let overwrite' :: CInt
overwrite' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
overwrite
    Ptr Entry -> CInt -> IO ()
gtk_entry_set_overwrite_mode Ptr Entry
entry' CInt
overwrite'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetOverwriteModeMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetOverwriteModeMethodInfo a signature where
    overloadedMethod = 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
--           , 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, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 t'GI.Gtk.Objects.Entry.Entry'.
entrySetPlaceholderText ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> Maybe (T.Text)
    -- ^ /@text@/: a string to be displayed when /@entry@/ is empty and unfocused, or 'P.Nothing'
    -> m ()
entrySetPlaceholderText :: a -> Maybe Text -> m ()
entrySetPlaceholderText entry :: a
entry text :: Maybe Text
text = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    CString
maybeText <- case Maybe Text
text of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jText :: Text
jText -> do
            CString
jText' <- Text -> IO CString
textToCString Text
jText
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jText'
    Ptr Entry -> CString -> IO ()
gtk_entry_set_placeholder_text Ptr Entry
entry' CString
maybeText
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeText
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetPlaceholderTextMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetPlaceholderTextMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Double
    -- ^ /@fraction@/: fraction of the task that’s been completed
    -> m ()
entrySetProgressFraction :: a -> Double -> m ()
entrySetProgressFraction entry :: a
entry fraction :: Double
fraction = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let fraction' :: CDouble
fraction' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fraction
    Ptr Entry -> CDouble -> IO ()
gtk_entry_set_progress_fraction Ptr Entry
entry' CDouble
fraction'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetProgressFractionMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetProgressFractionMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 call to 'GI.Gtk.Objects.Entry.entryProgressPulse'.
entrySetProgressPulseStep ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> Double
    -- ^ /@fraction@/: fraction between 0.0 and 1.0
    -> m ()
entrySetProgressPulseStep :: a -> Double -> m ()
entrySetProgressPulseStep entry :: a
entry fraction :: Double
fraction = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let fraction' :: CDouble
fraction' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fraction
    Ptr Entry -> CDouble -> IO ()
gtk_entry_set_progress_pulse_step Ptr Entry
entry' CDouble
fraction'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetProgressPulseStepMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetProgressPulseStepMethodInfo a signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tabs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "TabArray" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoTabArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 t'GI.Pango.Structs.TabArray.TabArray'; the tabstops in the array are applied to the entry
-- text.
entrySetTabs ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> Maybe (Pango.TabArray.TabArray)
    -- ^ /@tabs@/: a t'GI.Pango.Structs.TabArray.TabArray'
    -> m ()
entrySetTabs :: a -> Maybe TabArray -> m ()
entrySetTabs entry :: a
entry tabs :: Maybe TabArray
tabs = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr TabArray
maybeTabs <- case Maybe TabArray
tabs of
        Nothing -> Ptr TabArray -> IO (Ptr TabArray)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TabArray
forall a. Ptr a
nullPtr
        Just jTabs :: TabArray
jTabs -> do
            Ptr TabArray
jTabs' <- TabArray -> IO (Ptr TabArray)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TabArray
jTabs
            Ptr TabArray -> IO (Ptr TabArray)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TabArray
jTabs'
    Ptr Entry -> Ptr TabArray -> IO ()
gtk_entry_set_tabs Ptr Entry
entry' Ptr TabArray
maybeTabs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    Maybe TabArray -> (TabArray -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TabArray
tabs TabArray -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetTabsMethodInfo
instance (signature ~ (Maybe (Pango.TabArray.TabArray) -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetTabsMethodInfo a signature where
    overloadedMethod = 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
--           , 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\n          as plaintext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 t'GI.Gtk.Objects.Entry.Entry':@/input-purpose/@
-- 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 t'GI.Gtk.Objects.Entry.Entry'
    -> Bool
    -- ^ /@visible@/: 'P.True' if the contents of the entry are displayed
    --           as plaintext
    -> m ()
entrySetVisibility :: a -> Bool -> m ()
entrySetVisibility entry :: a
entry visible :: Bool
visible = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    let visible' :: CInt
visible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
visible
    Ptr Entry -> CInt -> IO ()
gtk_entry_set_visibility Ptr Entry
entry' CInt
visible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EntrySetVisibilityMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEntry a) => O.MethodInfo EntrySetVisibilityMethodInfo a signature where
    overloadedMethod = 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
--           , 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 previously set with
-- 'GI.Gtk.Objects.Entry.entrySetInvisibleChar'. So that the
-- default invisible char is used again.
entryUnsetInvisibleChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsEntry a) =>
    a
    -- ^ /@entry@/: a t'GI.Gtk.Objects.Entry.Entry'
    -> m ()
entryUnsetInvisibleChar :: a -> m ()
entryUnsetInvisibleChar entry :: a
entry = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Entry
entry' <- a -> IO (Ptr Entry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
entry
    Ptr Entry -> IO ()
gtk_entry_unset_invisible_char Ptr Entry
entry'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif