{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-} -- Generated code. {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE ForeignFunctionInterface, ConstraintKinds, TypeFamilies, MultiParamTypeClasses, KindSignatures, FlexibleInstances, UndecidableInstances, DataKinds, OverloadedStrings, NegativeLiterals, FlexibleContexts #-} module GI.GtkAttributes where import Prelude () import Data.GI.Base.ShortPrelude import Data.Char import Data.Int import Data.Word import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 (ByteString) import qualified Data.Map as Map import Foreign.C import Foreign.Ptr import Foreign.ForeignPtr import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.Storable (peek, poke, sizeOf) import Control.Applicative ((<$>)) import Control.Exception (onException) import Control.Monad.IO.Class import qualified Data.Text as T import Data.GI.Base.Attributes hiding (get, set) import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions import Data.GI.Base.Closure import Data.GI.Base.GError import Data.GI.Base.GHashTable import Data.GI.Base.GParamSpec import Data.GI.Base.GVariant import Data.GI.Base.GValue import Data.GI.Base.ManagedPtr import Data.GI.Base.Overloading import Data.GI.Base.Properties hiding (new) import Data.GI.Base.Signals (SignalConnectMode(..), connectSignalFunPtr, SignalHandlerId) import Data.GI.Base.Utils import qualified GI.Atk as Atk import qualified GI.AtkAttributes as AtkA import qualified GI.Gdk as Gdk import qualified GI.GdkAttributes as GdkA import qualified GI.GdkPixbuf as GdkPixbuf import qualified GI.GdkPixbufAttributes as GdkPixbufA import qualified GI.Gio as Gio import qualified GI.GioAttributes as GioA import qualified GI.Pango as Pango import qualified GI.PangoAttributes as PangoA import qualified GI.Cairo as Cairo import qualified GI.CairoAttributes as CairoA import GI.Gtk -- VVV Prop "artists" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogArtists :: (MonadIO m, AboutDialogK o) => o -> m [T.Text] getAboutDialogArtists obj = liftIO $ getObjectPropertyStringArray obj "artists" setAboutDialogArtists :: (MonadIO m, AboutDialogK o) => o -> [T.Text] -> m () setAboutDialogArtists obj val = liftIO $ setObjectPropertyStringArray obj "artists" val constructAboutDialogArtists :: [T.Text] -> IO ([Char], GValue) constructAboutDialogArtists val = constructObjectPropertyStringArray "artists" val data AboutDialogArtistsPropertyInfo instance AttrInfo AboutDialogArtistsPropertyInfo where type AttrAllowedOps AboutDialogArtistsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogArtistsPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint AboutDialogArtistsPropertyInfo = AboutDialogK type AttrGetType AboutDialogArtistsPropertyInfo = [T.Text] type AttrLabel AboutDialogArtistsPropertyInfo = "AboutDialog::artists" attrGet _ = getAboutDialogArtists attrSet _ = setAboutDialogArtists attrConstruct _ = constructAboutDialogArtists -- VVV Prop "authors" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogAuthors :: (MonadIO m, AboutDialogK o) => o -> m [T.Text] getAboutDialogAuthors obj = liftIO $ getObjectPropertyStringArray obj "authors" setAboutDialogAuthors :: (MonadIO m, AboutDialogK o) => o -> [T.Text] -> m () setAboutDialogAuthors obj val = liftIO $ setObjectPropertyStringArray obj "authors" val constructAboutDialogAuthors :: [T.Text] -> IO ([Char], GValue) constructAboutDialogAuthors val = constructObjectPropertyStringArray "authors" val data AboutDialogAuthorsPropertyInfo instance AttrInfo AboutDialogAuthorsPropertyInfo where type AttrAllowedOps AboutDialogAuthorsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogAuthorsPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint AboutDialogAuthorsPropertyInfo = AboutDialogK type AttrGetType AboutDialogAuthorsPropertyInfo = [T.Text] type AttrLabel AboutDialogAuthorsPropertyInfo = "AboutDialog::authors" attrGet _ = getAboutDialogAuthors attrSet _ = setAboutDialogAuthors attrConstruct _ = constructAboutDialogAuthors -- VVV Prop "comments" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogComments :: (MonadIO m, AboutDialogK o) => o -> m T.Text getAboutDialogComments obj = liftIO $ getObjectPropertyString obj "comments" setAboutDialogComments :: (MonadIO m, AboutDialogK o) => o -> T.Text -> m () setAboutDialogComments obj val = liftIO $ setObjectPropertyString obj "comments" val constructAboutDialogComments :: T.Text -> IO ([Char], GValue) constructAboutDialogComments val = constructObjectPropertyString "comments" val data AboutDialogCommentsPropertyInfo instance AttrInfo AboutDialogCommentsPropertyInfo where type AttrAllowedOps AboutDialogCommentsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogCommentsPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AboutDialogCommentsPropertyInfo = AboutDialogK type AttrGetType AboutDialogCommentsPropertyInfo = T.Text type AttrLabel AboutDialogCommentsPropertyInfo = "AboutDialog::comments" attrGet _ = getAboutDialogComments attrSet _ = setAboutDialogComments attrConstruct _ = constructAboutDialogComments -- VVV Prop "copyright" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogCopyright :: (MonadIO m, AboutDialogK o) => o -> m T.Text getAboutDialogCopyright obj = liftIO $ getObjectPropertyString obj "copyright" setAboutDialogCopyright :: (MonadIO m, AboutDialogK o) => o -> T.Text -> m () setAboutDialogCopyright obj val = liftIO $ setObjectPropertyString obj "copyright" val constructAboutDialogCopyright :: T.Text -> IO ([Char], GValue) constructAboutDialogCopyright val = constructObjectPropertyString "copyright" val data AboutDialogCopyrightPropertyInfo instance AttrInfo AboutDialogCopyrightPropertyInfo where type AttrAllowedOps AboutDialogCopyrightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogCopyrightPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AboutDialogCopyrightPropertyInfo = AboutDialogK type AttrGetType AboutDialogCopyrightPropertyInfo = T.Text type AttrLabel AboutDialogCopyrightPropertyInfo = "AboutDialog::copyright" attrGet _ = getAboutDialogCopyright attrSet _ = setAboutDialogCopyright attrConstruct _ = constructAboutDialogCopyright -- VVV Prop "documenters" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogDocumenters :: (MonadIO m, AboutDialogK o) => o -> m [T.Text] getAboutDialogDocumenters obj = liftIO $ getObjectPropertyStringArray obj "documenters" setAboutDialogDocumenters :: (MonadIO m, AboutDialogK o) => o -> [T.Text] -> m () setAboutDialogDocumenters obj val = liftIO $ setObjectPropertyStringArray obj "documenters" val constructAboutDialogDocumenters :: [T.Text] -> IO ([Char], GValue) constructAboutDialogDocumenters val = constructObjectPropertyStringArray "documenters" val data AboutDialogDocumentersPropertyInfo instance AttrInfo AboutDialogDocumentersPropertyInfo where type AttrAllowedOps AboutDialogDocumentersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogDocumentersPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint AboutDialogDocumentersPropertyInfo = AboutDialogK type AttrGetType AboutDialogDocumentersPropertyInfo = [T.Text] type AttrLabel AboutDialogDocumentersPropertyInfo = "AboutDialog::documenters" attrGet _ = getAboutDialogDocumenters attrSet _ = setAboutDialogDocumenters attrConstruct _ = constructAboutDialogDocumenters -- VVV Prop "license" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogLicense :: (MonadIO m, AboutDialogK o) => o -> m T.Text getAboutDialogLicense obj = liftIO $ getObjectPropertyString obj "license" setAboutDialogLicense :: (MonadIO m, AboutDialogK o) => o -> T.Text -> m () setAboutDialogLicense obj val = liftIO $ setObjectPropertyString obj "license" val constructAboutDialogLicense :: T.Text -> IO ([Char], GValue) constructAboutDialogLicense val = constructObjectPropertyString "license" val data AboutDialogLicensePropertyInfo instance AttrInfo AboutDialogLicensePropertyInfo where type AttrAllowedOps AboutDialogLicensePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogLicensePropertyInfo = (~) T.Text type AttrBaseTypeConstraint AboutDialogLicensePropertyInfo = AboutDialogK type AttrGetType AboutDialogLicensePropertyInfo = T.Text type AttrLabel AboutDialogLicensePropertyInfo = "AboutDialog::license" attrGet _ = getAboutDialogLicense attrSet _ = setAboutDialogLicense attrConstruct _ = constructAboutDialogLicense -- VVV Prop "license-type" -- Type: TInterface "Gtk" "License" -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogLicenseType :: (MonadIO m, AboutDialogK o) => o -> m License getAboutDialogLicenseType obj = liftIO $ getObjectPropertyEnum obj "license-type" setAboutDialogLicenseType :: (MonadIO m, AboutDialogK o) => o -> License -> m () setAboutDialogLicenseType obj val = liftIO $ setObjectPropertyEnum obj "license-type" val constructAboutDialogLicenseType :: License -> IO ([Char], GValue) constructAboutDialogLicenseType val = constructObjectPropertyEnum "license-type" val data AboutDialogLicenseTypePropertyInfo instance AttrInfo AboutDialogLicenseTypePropertyInfo where type AttrAllowedOps AboutDialogLicenseTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogLicenseTypePropertyInfo = (~) License type AttrBaseTypeConstraint AboutDialogLicenseTypePropertyInfo = AboutDialogK type AttrGetType AboutDialogLicenseTypePropertyInfo = License type AttrLabel AboutDialogLicenseTypePropertyInfo = "AboutDialog::license-type" attrGet _ = getAboutDialogLicenseType attrSet _ = setAboutDialogLicenseType attrConstruct _ = constructAboutDialogLicenseType -- VVV Prop "logo" -- Type: TInterface "GdkPixbuf" "Pixbuf" -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogLogo :: (MonadIO m, AboutDialogK o) => o -> m GdkPixbuf.Pixbuf getAboutDialogLogo obj = liftIO $ getObjectPropertyObject obj "logo" GdkPixbuf.Pixbuf setAboutDialogLogo :: (MonadIO m, AboutDialogK o, GdkPixbuf.PixbufK a) => o -> a -> m () setAboutDialogLogo obj val = liftIO $ setObjectPropertyObject obj "logo" val constructAboutDialogLogo :: (GdkPixbuf.PixbufK a) => a -> IO ([Char], GValue) constructAboutDialogLogo val = constructObjectPropertyObject "logo" val data AboutDialogLogoPropertyInfo instance AttrInfo AboutDialogLogoPropertyInfo where type AttrAllowedOps AboutDialogLogoPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogLogoPropertyInfo = GdkPixbuf.PixbufK type AttrBaseTypeConstraint AboutDialogLogoPropertyInfo = AboutDialogK type AttrGetType AboutDialogLogoPropertyInfo = GdkPixbuf.Pixbuf type AttrLabel AboutDialogLogoPropertyInfo = "AboutDialog::logo" attrGet _ = getAboutDialogLogo attrSet _ = setAboutDialogLogo attrConstruct _ = constructAboutDialogLogo -- VVV Prop "logo-icon-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogLogoIconName :: (MonadIO m, AboutDialogK o) => o -> m T.Text getAboutDialogLogoIconName obj = liftIO $ getObjectPropertyString obj "logo-icon-name" setAboutDialogLogoIconName :: (MonadIO m, AboutDialogK o) => o -> T.Text -> m () setAboutDialogLogoIconName obj val = liftIO $ setObjectPropertyString obj "logo-icon-name" val constructAboutDialogLogoIconName :: T.Text -> IO ([Char], GValue) constructAboutDialogLogoIconName val = constructObjectPropertyString "logo-icon-name" val data AboutDialogLogoIconNamePropertyInfo instance AttrInfo AboutDialogLogoIconNamePropertyInfo where type AttrAllowedOps AboutDialogLogoIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogLogoIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint AboutDialogLogoIconNamePropertyInfo = AboutDialogK type AttrGetType AboutDialogLogoIconNamePropertyInfo = T.Text type AttrLabel AboutDialogLogoIconNamePropertyInfo = "AboutDialog::logo-icon-name" attrGet _ = getAboutDialogLogoIconName attrSet _ = setAboutDialogLogoIconName attrConstruct _ = constructAboutDialogLogoIconName -- VVV Prop "program-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogProgramName :: (MonadIO m, AboutDialogK o) => o -> m T.Text getAboutDialogProgramName obj = liftIO $ getObjectPropertyString obj "program-name" setAboutDialogProgramName :: (MonadIO m, AboutDialogK o) => o -> T.Text -> m () setAboutDialogProgramName obj val = liftIO $ setObjectPropertyString obj "program-name" val constructAboutDialogProgramName :: T.Text -> IO ([Char], GValue) constructAboutDialogProgramName val = constructObjectPropertyString "program-name" val data AboutDialogProgramNamePropertyInfo instance AttrInfo AboutDialogProgramNamePropertyInfo where type AttrAllowedOps AboutDialogProgramNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogProgramNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint AboutDialogProgramNamePropertyInfo = AboutDialogK type AttrGetType AboutDialogProgramNamePropertyInfo = T.Text type AttrLabel AboutDialogProgramNamePropertyInfo = "AboutDialog::program-name" attrGet _ = getAboutDialogProgramName attrSet _ = setAboutDialogProgramName attrConstruct _ = constructAboutDialogProgramName -- VVV Prop "translator-credits" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogTranslatorCredits :: (MonadIO m, AboutDialogK o) => o -> m T.Text getAboutDialogTranslatorCredits obj = liftIO $ getObjectPropertyString obj "translator-credits" setAboutDialogTranslatorCredits :: (MonadIO m, AboutDialogK o) => o -> T.Text -> m () setAboutDialogTranslatorCredits obj val = liftIO $ setObjectPropertyString obj "translator-credits" val constructAboutDialogTranslatorCredits :: T.Text -> IO ([Char], GValue) constructAboutDialogTranslatorCredits val = constructObjectPropertyString "translator-credits" val data AboutDialogTranslatorCreditsPropertyInfo instance AttrInfo AboutDialogTranslatorCreditsPropertyInfo where type AttrAllowedOps AboutDialogTranslatorCreditsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogTranslatorCreditsPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AboutDialogTranslatorCreditsPropertyInfo = AboutDialogK type AttrGetType AboutDialogTranslatorCreditsPropertyInfo = T.Text type AttrLabel AboutDialogTranslatorCreditsPropertyInfo = "AboutDialog::translator-credits" attrGet _ = getAboutDialogTranslatorCredits attrSet _ = setAboutDialogTranslatorCredits attrConstruct _ = constructAboutDialogTranslatorCredits -- VVV Prop "version" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogVersion :: (MonadIO m, AboutDialogK o) => o -> m T.Text getAboutDialogVersion obj = liftIO $ getObjectPropertyString obj "version" setAboutDialogVersion :: (MonadIO m, AboutDialogK o) => o -> T.Text -> m () setAboutDialogVersion obj val = liftIO $ setObjectPropertyString obj "version" val constructAboutDialogVersion :: T.Text -> IO ([Char], GValue) constructAboutDialogVersion val = constructObjectPropertyString "version" val data AboutDialogVersionPropertyInfo instance AttrInfo AboutDialogVersionPropertyInfo where type AttrAllowedOps AboutDialogVersionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogVersionPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AboutDialogVersionPropertyInfo = AboutDialogK type AttrGetType AboutDialogVersionPropertyInfo = T.Text type AttrLabel AboutDialogVersionPropertyInfo = "AboutDialog::version" attrGet _ = getAboutDialogVersion attrSet _ = setAboutDialogVersion attrConstruct _ = constructAboutDialogVersion -- VVV Prop "website" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogWebsite :: (MonadIO m, AboutDialogK o) => o -> m T.Text getAboutDialogWebsite obj = liftIO $ getObjectPropertyString obj "website" setAboutDialogWebsite :: (MonadIO m, AboutDialogK o) => o -> T.Text -> m () setAboutDialogWebsite obj val = liftIO $ setObjectPropertyString obj "website" val constructAboutDialogWebsite :: T.Text -> IO ([Char], GValue) constructAboutDialogWebsite val = constructObjectPropertyString "website" val data AboutDialogWebsitePropertyInfo instance AttrInfo AboutDialogWebsitePropertyInfo where type AttrAllowedOps AboutDialogWebsitePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogWebsitePropertyInfo = (~) T.Text type AttrBaseTypeConstraint AboutDialogWebsitePropertyInfo = AboutDialogK type AttrGetType AboutDialogWebsitePropertyInfo = T.Text type AttrLabel AboutDialogWebsitePropertyInfo = "AboutDialog::website" attrGet _ = getAboutDialogWebsite attrSet _ = setAboutDialogWebsite attrConstruct _ = constructAboutDialogWebsite -- VVV Prop "website-label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogWebsiteLabel :: (MonadIO m, AboutDialogK o) => o -> m T.Text getAboutDialogWebsiteLabel obj = liftIO $ getObjectPropertyString obj "website-label" setAboutDialogWebsiteLabel :: (MonadIO m, AboutDialogK o) => o -> T.Text -> m () setAboutDialogWebsiteLabel obj val = liftIO $ setObjectPropertyString obj "website-label" val constructAboutDialogWebsiteLabel :: T.Text -> IO ([Char], GValue) constructAboutDialogWebsiteLabel val = constructObjectPropertyString "website-label" val data AboutDialogWebsiteLabelPropertyInfo instance AttrInfo AboutDialogWebsiteLabelPropertyInfo where type AttrAllowedOps AboutDialogWebsiteLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogWebsiteLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AboutDialogWebsiteLabelPropertyInfo = AboutDialogK type AttrGetType AboutDialogWebsiteLabelPropertyInfo = T.Text type AttrLabel AboutDialogWebsiteLabelPropertyInfo = "AboutDialog::website-label" attrGet _ = getAboutDialogWebsiteLabel attrSet _ = setAboutDialogWebsiteLabel attrConstruct _ = constructAboutDialogWebsiteLabel -- VVV Prop "wrap-license" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getAboutDialogWrapLicense :: (MonadIO m, AboutDialogK o) => o -> m Bool getAboutDialogWrapLicense obj = liftIO $ getObjectPropertyBool obj "wrap-license" setAboutDialogWrapLicense :: (MonadIO m, AboutDialogK o) => o -> Bool -> m () setAboutDialogWrapLicense obj val = liftIO $ setObjectPropertyBool obj "wrap-license" val constructAboutDialogWrapLicense :: Bool -> IO ([Char], GValue) constructAboutDialogWrapLicense val = constructObjectPropertyBool "wrap-license" val data AboutDialogWrapLicensePropertyInfo instance AttrInfo AboutDialogWrapLicensePropertyInfo where type AttrAllowedOps AboutDialogWrapLicensePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AboutDialogWrapLicensePropertyInfo = (~) Bool type AttrBaseTypeConstraint AboutDialogWrapLicensePropertyInfo = AboutDialogK type AttrGetType AboutDialogWrapLicensePropertyInfo = Bool type AttrLabel AboutDialogWrapLicensePropertyInfo = "AboutDialog::wrap-license" attrGet _ = getAboutDialogWrapLicense attrSet _ = setAboutDialogWrapLicense attrConstruct _ = constructAboutDialogWrapLicense type instance AttributeList AboutDialog = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("artists", AboutDialogArtistsPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("authors", AboutDialogAuthorsPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("comments", AboutDialogCommentsPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("copyright", AboutDialogCopyrightPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("documenters", AboutDialogDocumentersPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("license", AboutDialogLicensePropertyInfo), '("license-type", AboutDialogLicenseTypePropertyInfo), '("logo", AboutDialogLogoPropertyInfo), '("logo-icon-name", AboutDialogLogoIconNamePropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("program-name", AboutDialogProgramNamePropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("translator-credits", AboutDialogTranslatorCreditsPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-header-bar", DialogUseHeaderBarPropertyInfo), '("valign", WidgetValignPropertyInfo), '("version", AboutDialogVersionPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("website", AboutDialogWebsitePropertyInfo), '("website-label", AboutDialogWebsiteLabelPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo), '("wrap-license", AboutDialogWrapLicensePropertyInfo)] -- VVV Prop "is-locked" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getAccelGroupIsLocked :: (MonadIO m, AccelGroupK o) => o -> m Bool getAccelGroupIsLocked obj = liftIO $ getObjectPropertyBool obj "is-locked" data AccelGroupIsLockedPropertyInfo instance AttrInfo AccelGroupIsLockedPropertyInfo where type AttrAllowedOps AccelGroupIsLockedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint AccelGroupIsLockedPropertyInfo = (~) () type AttrBaseTypeConstraint AccelGroupIsLockedPropertyInfo = AccelGroupK type AttrGetType AccelGroupIsLockedPropertyInfo = Bool type AttrLabel AccelGroupIsLockedPropertyInfo = "AccelGroup::is-locked" attrGet _ = getAccelGroupIsLocked attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "modifier-mask" -- Type: TInterface "Gdk" "ModifierType" -- Flags: [PropertyReadable] getAccelGroupModifierMask :: (MonadIO m, AccelGroupK o) => o -> m [Gdk.ModifierType] getAccelGroupModifierMask obj = liftIO $ getObjectPropertyFlags obj "modifier-mask" data AccelGroupModifierMaskPropertyInfo instance AttrInfo AccelGroupModifierMaskPropertyInfo where type AttrAllowedOps AccelGroupModifierMaskPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint AccelGroupModifierMaskPropertyInfo = (~) () type AttrBaseTypeConstraint AccelGroupModifierMaskPropertyInfo = AccelGroupK type AttrGetType AccelGroupModifierMaskPropertyInfo = [Gdk.ModifierType] type AttrLabel AccelGroupModifierMaskPropertyInfo = "AccelGroup::modifier-mask" attrGet _ = getAccelGroupModifierMask attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList AccelGroup = '[ '("is-locked", AccelGroupIsLockedPropertyInfo), '("modifier-mask", AccelGroupModifierMaskPropertyInfo)] --- XXX Duplicated object with different types: --- Name {namespace = "Gtk", name = "Label"} -> Property {propName = "xalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gtk", name = "Misc"} -> Property {propName = "xalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Just (DeprecationInfo {deprecatedSinceVersion = Just "3.14", deprecationMessage = Just "Use gtk_widget_set_halign() instead. If you are using\n #GtkLabel, use #GtkLabel:xalign instead."})} --- XXX Duplicated object with different types: --- Name {namespace = "Gtk", name = "Label"} -> Property {propName = "yalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gtk", name = "Misc"} -> Property {propName = "yalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Just (DeprecationInfo {deprecatedSinceVersion = Just "3.14", deprecationMessage = Just "Use gtk_widget_set_valign() instead. If you are using\n #GtkLabel, use #GtkLabel:yalign instead."})} -- VVV Prop "accel-closure" -- Type: TInterface "GObject" "Closure" -- Flags: [PropertyReadable,PropertyWritable] getAccelLabelAccelClosure :: (MonadIO m, AccelLabelK o) => o -> m Closure getAccelLabelAccelClosure obj = liftIO $ getObjectPropertyBoxed obj "accel-closure" Closure setAccelLabelAccelClosure :: (MonadIO m, AccelLabelK o) => o -> Closure -> m () setAccelLabelAccelClosure obj val = liftIO $ setObjectPropertyBoxed obj "accel-closure" val constructAccelLabelAccelClosure :: Closure -> IO ([Char], GValue) constructAccelLabelAccelClosure val = constructObjectPropertyBoxed "accel-closure" val data AccelLabelAccelClosurePropertyInfo instance AttrInfo AccelLabelAccelClosurePropertyInfo where type AttrAllowedOps AccelLabelAccelClosurePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AccelLabelAccelClosurePropertyInfo = (~) Closure type AttrBaseTypeConstraint AccelLabelAccelClosurePropertyInfo = AccelLabelK type AttrGetType AccelLabelAccelClosurePropertyInfo = Closure type AttrLabel AccelLabelAccelClosurePropertyInfo = "AccelLabel::accel-closure" attrGet _ = getAccelLabelAccelClosure attrSet _ = setAccelLabelAccelClosure attrConstruct _ = constructAccelLabelAccelClosure -- VVV Prop "accel-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getAccelLabelAccelWidget :: (MonadIO m, AccelLabelK o) => o -> m Widget getAccelLabelAccelWidget obj = liftIO $ getObjectPropertyObject obj "accel-widget" Widget setAccelLabelAccelWidget :: (MonadIO m, AccelLabelK o, WidgetK a) => o -> a -> m () setAccelLabelAccelWidget obj val = liftIO $ setObjectPropertyObject obj "accel-widget" val constructAccelLabelAccelWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructAccelLabelAccelWidget val = constructObjectPropertyObject "accel-widget" val data AccelLabelAccelWidgetPropertyInfo instance AttrInfo AccelLabelAccelWidgetPropertyInfo where type AttrAllowedOps AccelLabelAccelWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AccelLabelAccelWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint AccelLabelAccelWidgetPropertyInfo = AccelLabelK type AttrGetType AccelLabelAccelWidgetPropertyInfo = Widget type AttrLabel AccelLabelAccelWidgetPropertyInfo = "AccelLabel::accel-widget" attrGet _ = getAccelLabelAccelWidget attrSet _ = setAccelLabelAccelWidget attrConstruct _ = constructAccelLabelAccelWidget type instance AttributeList AccelLabel = '[ '("accel-closure", AccelLabelAccelClosurePropertyInfo), '("accel-widget", AccelLabelAccelWidgetPropertyInfo), '("angle", LabelAnglePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("attributes", LabelAttributesPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("cursor-position", LabelCursorPositionPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("ellipsize", LabelEllipsizePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("justify", LabelJustifyPropertyInfo), '("label", LabelLabelPropertyInfo), '("lines", LabelLinesPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-width-chars", LabelMaxWidthCharsPropertyInfo), '("mnemonic-keyval", LabelMnemonicKeyvalPropertyInfo), '("mnemonic-widget", LabelMnemonicWidgetPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("pattern", LabelPatternPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("selectable", LabelSelectablePropertyInfo), '("selection-bound", LabelSelectionBoundPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("single-line-mode", LabelSingleLineModePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("track-visited-links", LabelTrackVisitedLinksPropertyInfo), '("use-markup", LabelUseMarkupPropertyInfo), '("use-underline", LabelUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-chars", LabelWidthCharsPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("wrap", LabelWrapPropertyInfo), '("wrap-mode", LabelWrapModePropertyInfo), '("xpad", MiscXpadPropertyInfo), '("ypad", MiscYpadPropertyInfo)] type instance AttributeList AccelMap = '[ ] -- VVV Prop "widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getAccessibleWidget :: (MonadIO m, AccessibleK o) => o -> m Widget getAccessibleWidget obj = liftIO $ getObjectPropertyObject obj "widget" Widget setAccessibleWidget :: (MonadIO m, AccessibleK o, WidgetK a) => o -> a -> m () setAccessibleWidget obj val = liftIO $ setObjectPropertyObject obj "widget" val constructAccessibleWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructAccessibleWidget val = constructObjectPropertyObject "widget" val data AccessibleWidgetPropertyInfo instance AttrInfo AccessibleWidgetPropertyInfo where type AttrAllowedOps AccessibleWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AccessibleWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint AccessibleWidgetPropertyInfo = AccessibleK type AttrGetType AccessibleWidgetPropertyInfo = Widget type AttrLabel AccessibleWidgetPropertyInfo = "Accessible::widget" attrGet _ = getAccessibleWidget attrSet _ = setAccessibleWidget attrConstruct _ = constructAccessibleWidget type instance AttributeList Accessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "action-group" -- Type: TInterface "Gtk" "ActionGroup" -- Flags: [PropertyReadable,PropertyWritable] getActionActionGroup :: (MonadIO m, ActionK o) => o -> m ActionGroup getActionActionGroup obj = liftIO $ getObjectPropertyObject obj "action-group" ActionGroup setActionActionGroup :: (MonadIO m, ActionK o, ActionGroupK a) => o -> a -> m () setActionActionGroup obj val = liftIO $ setObjectPropertyObject obj "action-group" val constructActionActionGroup :: (ActionGroupK a) => a -> IO ([Char], GValue) constructActionActionGroup val = constructObjectPropertyObject "action-group" val data ActionActionGroupPropertyInfo instance AttrInfo ActionActionGroupPropertyInfo where type AttrAllowedOps ActionActionGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionActionGroupPropertyInfo = ActionGroupK type AttrBaseTypeConstraint ActionActionGroupPropertyInfo = ActionK type AttrGetType ActionActionGroupPropertyInfo = ActionGroup type AttrLabel ActionActionGroupPropertyInfo = "Action::action-group" attrGet _ = getActionActionGroup attrSet _ = setActionActionGroup attrConstruct _ = constructActionActionGroup -- VVV Prop "always-show-image" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getActionAlwaysShowImage :: (MonadIO m, ActionK o) => o -> m Bool getActionAlwaysShowImage obj = liftIO $ getObjectPropertyBool obj "always-show-image" setActionAlwaysShowImage :: (MonadIO m, ActionK o) => o -> Bool -> m () setActionAlwaysShowImage obj val = liftIO $ setObjectPropertyBool obj "always-show-image" val constructActionAlwaysShowImage :: Bool -> IO ([Char], GValue) constructActionAlwaysShowImage val = constructObjectPropertyBool "always-show-image" val data ActionAlwaysShowImagePropertyInfo instance AttrInfo ActionAlwaysShowImagePropertyInfo where type AttrAllowedOps ActionAlwaysShowImagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionAlwaysShowImagePropertyInfo = (~) Bool type AttrBaseTypeConstraint ActionAlwaysShowImagePropertyInfo = ActionK type AttrGetType ActionAlwaysShowImagePropertyInfo = Bool type AttrLabel ActionAlwaysShowImagePropertyInfo = "Action::always-show-image" attrGet _ = getActionAlwaysShowImage attrSet _ = setActionAlwaysShowImage attrConstruct _ = constructActionAlwaysShowImage -- VVV Prop "gicon" -- Type: TInterface "Gio" "Icon" -- Flags: [PropertyReadable,PropertyWritable] getActionGicon :: (MonadIO m, ActionK o) => o -> m Gio.Icon getActionGicon obj = liftIO $ getObjectPropertyObject obj "gicon" Gio.Icon setActionGicon :: (MonadIO m, ActionK o, Gio.IconK a) => o -> a -> m () setActionGicon obj val = liftIO $ setObjectPropertyObject obj "gicon" val constructActionGicon :: (Gio.IconK a) => a -> IO ([Char], GValue) constructActionGicon val = constructObjectPropertyObject "gicon" val data ActionGiconPropertyInfo instance AttrInfo ActionGiconPropertyInfo where type AttrAllowedOps ActionGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionGiconPropertyInfo = Gio.IconK type AttrBaseTypeConstraint ActionGiconPropertyInfo = ActionK type AttrGetType ActionGiconPropertyInfo = Gio.Icon type AttrLabel ActionGiconPropertyInfo = "Action::gicon" attrGet _ = getActionGicon attrSet _ = setActionGicon attrConstruct _ = constructActionGicon -- VVV Prop "hide-if-empty" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getActionHideIfEmpty :: (MonadIO m, ActionK o) => o -> m Bool getActionHideIfEmpty obj = liftIO $ getObjectPropertyBool obj "hide-if-empty" setActionHideIfEmpty :: (MonadIO m, ActionK o) => o -> Bool -> m () setActionHideIfEmpty obj val = liftIO $ setObjectPropertyBool obj "hide-if-empty" val constructActionHideIfEmpty :: Bool -> IO ([Char], GValue) constructActionHideIfEmpty val = constructObjectPropertyBool "hide-if-empty" val data ActionHideIfEmptyPropertyInfo instance AttrInfo ActionHideIfEmptyPropertyInfo where type AttrAllowedOps ActionHideIfEmptyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionHideIfEmptyPropertyInfo = (~) Bool type AttrBaseTypeConstraint ActionHideIfEmptyPropertyInfo = ActionK type AttrGetType ActionHideIfEmptyPropertyInfo = Bool type AttrLabel ActionHideIfEmptyPropertyInfo = "Action::hide-if-empty" attrGet _ = getActionHideIfEmpty attrSet _ = setActionHideIfEmpty attrConstruct _ = constructActionHideIfEmpty -- VVV Prop "icon-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getActionIconName :: (MonadIO m, ActionK o) => o -> m T.Text getActionIconName obj = liftIO $ getObjectPropertyString obj "icon-name" setActionIconName :: (MonadIO m, ActionK o) => o -> T.Text -> m () setActionIconName obj val = liftIO $ setObjectPropertyString obj "icon-name" val constructActionIconName :: T.Text -> IO ([Char], GValue) constructActionIconName val = constructObjectPropertyString "icon-name" val data ActionIconNamePropertyInfo instance AttrInfo ActionIconNamePropertyInfo where type AttrAllowedOps ActionIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ActionIconNamePropertyInfo = ActionK type AttrGetType ActionIconNamePropertyInfo = T.Text type AttrLabel ActionIconNamePropertyInfo = "Action::icon-name" attrGet _ = getActionIconName attrSet _ = setActionIconName attrConstruct _ = constructActionIconName -- VVV Prop "is-important" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getActionIsImportant :: (MonadIO m, ActionK o) => o -> m Bool getActionIsImportant obj = liftIO $ getObjectPropertyBool obj "is-important" setActionIsImportant :: (MonadIO m, ActionK o) => o -> Bool -> m () setActionIsImportant obj val = liftIO $ setObjectPropertyBool obj "is-important" val constructActionIsImportant :: Bool -> IO ([Char], GValue) constructActionIsImportant val = constructObjectPropertyBool "is-important" val data ActionIsImportantPropertyInfo instance AttrInfo ActionIsImportantPropertyInfo where type AttrAllowedOps ActionIsImportantPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionIsImportantPropertyInfo = (~) Bool type AttrBaseTypeConstraint ActionIsImportantPropertyInfo = ActionK type AttrGetType ActionIsImportantPropertyInfo = Bool type AttrLabel ActionIsImportantPropertyInfo = "Action::is-important" attrGet _ = getActionIsImportant attrSet _ = setActionIsImportant attrConstruct _ = constructActionIsImportant -- VVV Prop "label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getActionLabel :: (MonadIO m, ActionK o) => o -> m T.Text getActionLabel obj = liftIO $ getObjectPropertyString obj "label" setActionLabel :: (MonadIO m, ActionK o) => o -> T.Text -> m () setActionLabel obj val = liftIO $ setObjectPropertyString obj "label" val constructActionLabel :: T.Text -> IO ([Char], GValue) constructActionLabel val = constructObjectPropertyString "label" val data ActionLabelPropertyInfo instance AttrInfo ActionLabelPropertyInfo where type AttrAllowedOps ActionLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ActionLabelPropertyInfo = ActionK type AttrGetType ActionLabelPropertyInfo = T.Text type AttrLabel ActionLabelPropertyInfo = "Action::label" attrGet _ = getActionLabel attrSet _ = setActionLabel attrConstruct _ = constructActionLabel -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getActionName :: (MonadIO m, ActionK o) => o -> m T.Text getActionName obj = liftIO $ getObjectPropertyString obj "name" constructActionName :: T.Text -> IO ([Char], GValue) constructActionName val = constructObjectPropertyString "name" val data ActionNamePropertyInfo instance AttrInfo ActionNamePropertyInfo where type AttrAllowedOps ActionNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ActionNamePropertyInfo = ActionK type AttrGetType ActionNamePropertyInfo = T.Text type AttrLabel ActionNamePropertyInfo = "Action::name" attrGet _ = getActionName attrSet _ = undefined attrConstruct _ = constructActionName -- VVV Prop "sensitive" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getActionSensitive :: (MonadIO m, ActionK o) => o -> m Bool getActionSensitive obj = liftIO $ getObjectPropertyBool obj "sensitive" setActionSensitive :: (MonadIO m, ActionK o) => o -> Bool -> m () setActionSensitive obj val = liftIO $ setObjectPropertyBool obj "sensitive" val constructActionSensitive :: Bool -> IO ([Char], GValue) constructActionSensitive val = constructObjectPropertyBool "sensitive" val data ActionSensitivePropertyInfo instance AttrInfo ActionSensitivePropertyInfo where type AttrAllowedOps ActionSensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionSensitivePropertyInfo = (~) Bool type AttrBaseTypeConstraint ActionSensitivePropertyInfo = ActionK type AttrGetType ActionSensitivePropertyInfo = Bool type AttrLabel ActionSensitivePropertyInfo = "Action::sensitive" attrGet _ = getActionSensitive attrSet _ = setActionSensitive attrConstruct _ = constructActionSensitive -- VVV Prop "short-label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getActionShortLabel :: (MonadIO m, ActionK o) => o -> m T.Text getActionShortLabel obj = liftIO $ getObjectPropertyString obj "short-label" setActionShortLabel :: (MonadIO m, ActionK o) => o -> T.Text -> m () setActionShortLabel obj val = liftIO $ setObjectPropertyString obj "short-label" val constructActionShortLabel :: T.Text -> IO ([Char], GValue) constructActionShortLabel val = constructObjectPropertyString "short-label" val data ActionShortLabelPropertyInfo instance AttrInfo ActionShortLabelPropertyInfo where type AttrAllowedOps ActionShortLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionShortLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ActionShortLabelPropertyInfo = ActionK type AttrGetType ActionShortLabelPropertyInfo = T.Text type AttrLabel ActionShortLabelPropertyInfo = "Action::short-label" attrGet _ = getActionShortLabel attrSet _ = setActionShortLabel attrConstruct _ = constructActionShortLabel -- VVV Prop "stock-id" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getActionStockId :: (MonadIO m, ActionK o) => o -> m T.Text getActionStockId obj = liftIO $ getObjectPropertyString obj "stock-id" setActionStockId :: (MonadIO m, ActionK o) => o -> T.Text -> m () setActionStockId obj val = liftIO $ setObjectPropertyString obj "stock-id" val constructActionStockId :: T.Text -> IO ([Char], GValue) constructActionStockId val = constructObjectPropertyString "stock-id" val data ActionStockIdPropertyInfo instance AttrInfo ActionStockIdPropertyInfo where type AttrAllowedOps ActionStockIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionStockIdPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ActionStockIdPropertyInfo = ActionK type AttrGetType ActionStockIdPropertyInfo = T.Text type AttrLabel ActionStockIdPropertyInfo = "Action::stock-id" attrGet _ = getActionStockId attrSet _ = setActionStockId attrConstruct _ = constructActionStockId -- VVV Prop "tooltip" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getActionTooltip :: (MonadIO m, ActionK o) => o -> m T.Text getActionTooltip obj = liftIO $ getObjectPropertyString obj "tooltip" setActionTooltip :: (MonadIO m, ActionK o) => o -> T.Text -> m () setActionTooltip obj val = liftIO $ setObjectPropertyString obj "tooltip" val constructActionTooltip :: T.Text -> IO ([Char], GValue) constructActionTooltip val = constructObjectPropertyString "tooltip" val data ActionTooltipPropertyInfo instance AttrInfo ActionTooltipPropertyInfo where type AttrAllowedOps ActionTooltipPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionTooltipPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ActionTooltipPropertyInfo = ActionK type AttrGetType ActionTooltipPropertyInfo = T.Text type AttrLabel ActionTooltipPropertyInfo = "Action::tooltip" attrGet _ = getActionTooltip attrSet _ = setActionTooltip attrConstruct _ = constructActionTooltip -- VVV Prop "visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getActionVisible :: (MonadIO m, ActionK o) => o -> m Bool getActionVisible obj = liftIO $ getObjectPropertyBool obj "visible" setActionVisible :: (MonadIO m, ActionK o) => o -> Bool -> m () setActionVisible obj val = liftIO $ setObjectPropertyBool obj "visible" val constructActionVisible :: Bool -> IO ([Char], GValue) constructActionVisible val = constructObjectPropertyBool "visible" val data ActionVisiblePropertyInfo instance AttrInfo ActionVisiblePropertyInfo where type AttrAllowedOps ActionVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionVisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint ActionVisiblePropertyInfo = ActionK type AttrGetType ActionVisiblePropertyInfo = Bool type AttrLabel ActionVisiblePropertyInfo = "Action::visible" attrGet _ = getActionVisible attrSet _ = setActionVisible attrConstruct _ = constructActionVisible -- VVV Prop "visible-horizontal" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getActionVisibleHorizontal :: (MonadIO m, ActionK o) => o -> m Bool getActionVisibleHorizontal obj = liftIO $ getObjectPropertyBool obj "visible-horizontal" setActionVisibleHorizontal :: (MonadIO m, ActionK o) => o -> Bool -> m () setActionVisibleHorizontal obj val = liftIO $ setObjectPropertyBool obj "visible-horizontal" val constructActionVisibleHorizontal :: Bool -> IO ([Char], GValue) constructActionVisibleHorizontal val = constructObjectPropertyBool "visible-horizontal" val data ActionVisibleHorizontalPropertyInfo instance AttrInfo ActionVisibleHorizontalPropertyInfo where type AttrAllowedOps ActionVisibleHorizontalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionVisibleHorizontalPropertyInfo = (~) Bool type AttrBaseTypeConstraint ActionVisibleHorizontalPropertyInfo = ActionK type AttrGetType ActionVisibleHorizontalPropertyInfo = Bool type AttrLabel ActionVisibleHorizontalPropertyInfo = "Action::visible-horizontal" attrGet _ = getActionVisibleHorizontal attrSet _ = setActionVisibleHorizontal attrConstruct _ = constructActionVisibleHorizontal -- VVV Prop "visible-overflown" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getActionVisibleOverflown :: (MonadIO m, ActionK o) => o -> m Bool getActionVisibleOverflown obj = liftIO $ getObjectPropertyBool obj "visible-overflown" setActionVisibleOverflown :: (MonadIO m, ActionK o) => o -> Bool -> m () setActionVisibleOverflown obj val = liftIO $ setObjectPropertyBool obj "visible-overflown" val constructActionVisibleOverflown :: Bool -> IO ([Char], GValue) constructActionVisibleOverflown val = constructObjectPropertyBool "visible-overflown" val data ActionVisibleOverflownPropertyInfo instance AttrInfo ActionVisibleOverflownPropertyInfo where type AttrAllowedOps ActionVisibleOverflownPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionVisibleOverflownPropertyInfo = (~) Bool type AttrBaseTypeConstraint ActionVisibleOverflownPropertyInfo = ActionK type AttrGetType ActionVisibleOverflownPropertyInfo = Bool type AttrLabel ActionVisibleOverflownPropertyInfo = "Action::visible-overflown" attrGet _ = getActionVisibleOverflown attrSet _ = setActionVisibleOverflown attrConstruct _ = constructActionVisibleOverflown -- VVV Prop "visible-vertical" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getActionVisibleVertical :: (MonadIO m, ActionK o) => o -> m Bool getActionVisibleVertical obj = liftIO $ getObjectPropertyBool obj "visible-vertical" setActionVisibleVertical :: (MonadIO m, ActionK o) => o -> Bool -> m () setActionVisibleVertical obj val = liftIO $ setObjectPropertyBool obj "visible-vertical" val constructActionVisibleVertical :: Bool -> IO ([Char], GValue) constructActionVisibleVertical val = constructObjectPropertyBool "visible-vertical" val data ActionVisibleVerticalPropertyInfo instance AttrInfo ActionVisibleVerticalPropertyInfo where type AttrAllowedOps ActionVisibleVerticalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionVisibleVerticalPropertyInfo = (~) Bool type AttrBaseTypeConstraint ActionVisibleVerticalPropertyInfo = ActionK type AttrGetType ActionVisibleVerticalPropertyInfo = Bool type AttrLabel ActionVisibleVerticalPropertyInfo = "Action::visible-vertical" attrGet _ = getActionVisibleVertical attrSet _ = setActionVisibleVertical attrConstruct _ = constructActionVisibleVertical type instance AttributeList Action = '[ '("action-group", ActionActionGroupPropertyInfo), '("always-show-image", ActionAlwaysShowImagePropertyInfo), '("gicon", ActionGiconPropertyInfo), '("hide-if-empty", ActionHideIfEmptyPropertyInfo), '("icon-name", ActionIconNamePropertyInfo), '("is-important", ActionIsImportantPropertyInfo), '("label", ActionLabelPropertyInfo), '("name", ActionNamePropertyInfo), '("sensitive", ActionSensitivePropertyInfo), '("short-label", ActionShortLabelPropertyInfo), '("stock-id", ActionStockIdPropertyInfo), '("tooltip", ActionTooltipPropertyInfo), '("visible", ActionVisiblePropertyInfo), '("visible-horizontal", ActionVisibleHorizontalPropertyInfo), '("visible-overflown", ActionVisibleOverflownPropertyInfo), '("visible-vertical", ActionVisibleVerticalPropertyInfo)] type instance AttributeList ActionBar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "accel-group" -- Type: TInterface "Gtk" "AccelGroup" -- Flags: [PropertyReadable,PropertyWritable] getActionGroupAccelGroup :: (MonadIO m, ActionGroupK o) => o -> m AccelGroup getActionGroupAccelGroup obj = liftIO $ getObjectPropertyObject obj "accel-group" AccelGroup setActionGroupAccelGroup :: (MonadIO m, ActionGroupK o, AccelGroupK a) => o -> a -> m () setActionGroupAccelGroup obj val = liftIO $ setObjectPropertyObject obj "accel-group" val constructActionGroupAccelGroup :: (AccelGroupK a) => a -> IO ([Char], GValue) constructActionGroupAccelGroup val = constructObjectPropertyObject "accel-group" val data ActionGroupAccelGroupPropertyInfo instance AttrInfo ActionGroupAccelGroupPropertyInfo where type AttrAllowedOps ActionGroupAccelGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionGroupAccelGroupPropertyInfo = AccelGroupK type AttrBaseTypeConstraint ActionGroupAccelGroupPropertyInfo = ActionGroupK type AttrGetType ActionGroupAccelGroupPropertyInfo = AccelGroup type AttrLabel ActionGroupAccelGroupPropertyInfo = "ActionGroup::accel-group" attrGet _ = getActionGroupAccelGroup attrSet _ = setActionGroupAccelGroup attrConstruct _ = constructActionGroupAccelGroup -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getActionGroupName :: (MonadIO m, ActionGroupK o) => o -> m T.Text getActionGroupName obj = liftIO $ getObjectPropertyString obj "name" constructActionGroupName :: T.Text -> IO ([Char], GValue) constructActionGroupName val = constructObjectPropertyString "name" val data ActionGroupNamePropertyInfo instance AttrInfo ActionGroupNamePropertyInfo where type AttrAllowedOps ActionGroupNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionGroupNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ActionGroupNamePropertyInfo = ActionGroupK type AttrGetType ActionGroupNamePropertyInfo = T.Text type AttrLabel ActionGroupNamePropertyInfo = "ActionGroup::name" attrGet _ = getActionGroupName attrSet _ = undefined attrConstruct _ = constructActionGroupName -- VVV Prop "sensitive" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getActionGroupSensitive :: (MonadIO m, ActionGroupK o) => o -> m Bool getActionGroupSensitive obj = liftIO $ getObjectPropertyBool obj "sensitive" setActionGroupSensitive :: (MonadIO m, ActionGroupK o) => o -> Bool -> m () setActionGroupSensitive obj val = liftIO $ setObjectPropertyBool obj "sensitive" val constructActionGroupSensitive :: Bool -> IO ([Char], GValue) constructActionGroupSensitive val = constructObjectPropertyBool "sensitive" val data ActionGroupSensitivePropertyInfo instance AttrInfo ActionGroupSensitivePropertyInfo where type AttrAllowedOps ActionGroupSensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionGroupSensitivePropertyInfo = (~) Bool type AttrBaseTypeConstraint ActionGroupSensitivePropertyInfo = ActionGroupK type AttrGetType ActionGroupSensitivePropertyInfo = Bool type AttrLabel ActionGroupSensitivePropertyInfo = "ActionGroup::sensitive" attrGet _ = getActionGroupSensitive attrSet _ = setActionGroupSensitive attrConstruct _ = constructActionGroupSensitive -- VVV Prop "visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getActionGroupVisible :: (MonadIO m, ActionGroupK o) => o -> m Bool getActionGroupVisible obj = liftIO $ getObjectPropertyBool obj "visible" setActionGroupVisible :: (MonadIO m, ActionGroupK o) => o -> Bool -> m () setActionGroupVisible obj val = liftIO $ setObjectPropertyBool obj "visible" val constructActionGroupVisible :: Bool -> IO ([Char], GValue) constructActionGroupVisible val = constructObjectPropertyBool "visible" val data ActionGroupVisiblePropertyInfo instance AttrInfo ActionGroupVisiblePropertyInfo where type AttrAllowedOps ActionGroupVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionGroupVisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint ActionGroupVisiblePropertyInfo = ActionGroupK type AttrGetType ActionGroupVisiblePropertyInfo = Bool type AttrLabel ActionGroupVisiblePropertyInfo = "ActionGroup::visible" attrGet _ = getActionGroupVisible attrSet _ = setActionGroupVisible attrConstruct _ = constructActionGroupVisible type instance AttributeList ActionGroup = '[ '("accel-group", ActionGroupAccelGroupPropertyInfo), '("name", ActionGroupNamePropertyInfo), '("sensitive", ActionGroupSensitivePropertyInfo), '("visible", ActionGroupVisiblePropertyInfo)] -- VVV Prop "action-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getActionableActionName :: (MonadIO m, ActionableK o) => o -> m T.Text getActionableActionName obj = liftIO $ getObjectPropertyString obj "action-name" setActionableActionName :: (MonadIO m, ActionableK o) => o -> T.Text -> m () setActionableActionName obj val = liftIO $ setObjectPropertyString obj "action-name" val constructActionableActionName :: T.Text -> IO ([Char], GValue) constructActionableActionName val = constructObjectPropertyString "action-name" val data ActionableActionNamePropertyInfo instance AttrInfo ActionableActionNamePropertyInfo where type AttrAllowedOps ActionableActionNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionableActionNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ActionableActionNamePropertyInfo = ActionableK type AttrGetType ActionableActionNamePropertyInfo = T.Text type AttrLabel ActionableActionNamePropertyInfo = "Actionable::action-name" attrGet _ = getActionableActionName attrSet _ = setActionableActionName attrConstruct _ = constructActionableActionName -- VVV Prop "action-target" -- Type: TVariant -- Flags: [PropertyReadable,PropertyWritable] getActionableActionTarget :: (MonadIO m, ActionableK o) => o -> m GVariant getActionableActionTarget obj = liftIO $ getObjectPropertyVariant obj "action-target" setActionableActionTarget :: (MonadIO m, ActionableK o) => o -> GVariant -> m () setActionableActionTarget obj val = liftIO $ setObjectPropertyVariant obj "action-target" val constructActionableActionTarget :: GVariant -> IO ([Char], GValue) constructActionableActionTarget val = constructObjectPropertyVariant "action-target" val data ActionableActionTargetPropertyInfo instance AttrInfo ActionableActionTargetPropertyInfo where type AttrAllowedOps ActionableActionTargetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActionableActionTargetPropertyInfo = (~) GVariant type AttrBaseTypeConstraint ActionableActionTargetPropertyInfo = ActionableK type AttrGetType ActionableActionTargetPropertyInfo = GVariant type AttrLabel ActionableActionTargetPropertyInfo = "Actionable::action-target" attrGet _ = getActionableActionTarget attrSet _ = setActionableActionTarget attrConstruct _ = constructActionableActionTarget type instance AttributeList Actionable = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "related-action" -- Type: TInterface "Gtk" "Action" -- Flags: [PropertyReadable,PropertyWritable] getActivatableRelatedAction :: (MonadIO m, ActivatableK o) => o -> m Action getActivatableRelatedAction obj = liftIO $ getObjectPropertyObject obj "related-action" Action setActivatableRelatedAction :: (MonadIO m, ActivatableK o, ActionK a) => o -> a -> m () setActivatableRelatedAction obj val = liftIO $ setObjectPropertyObject obj "related-action" val constructActivatableRelatedAction :: (ActionK a) => a -> IO ([Char], GValue) constructActivatableRelatedAction val = constructObjectPropertyObject "related-action" val data ActivatableRelatedActionPropertyInfo instance AttrInfo ActivatableRelatedActionPropertyInfo where type AttrAllowedOps ActivatableRelatedActionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActivatableRelatedActionPropertyInfo = ActionK type AttrBaseTypeConstraint ActivatableRelatedActionPropertyInfo = ActivatableK type AttrGetType ActivatableRelatedActionPropertyInfo = Action type AttrLabel ActivatableRelatedActionPropertyInfo = "Activatable::related-action" attrGet _ = getActivatableRelatedAction attrSet _ = setActivatableRelatedAction attrConstruct _ = constructActivatableRelatedAction -- VVV Prop "use-action-appearance" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getActivatableUseActionAppearance :: (MonadIO m, ActivatableK o) => o -> m Bool getActivatableUseActionAppearance obj = liftIO $ getObjectPropertyBool obj "use-action-appearance" setActivatableUseActionAppearance :: (MonadIO m, ActivatableK o) => o -> Bool -> m () setActivatableUseActionAppearance obj val = liftIO $ setObjectPropertyBool obj "use-action-appearance" val constructActivatableUseActionAppearance :: Bool -> IO ([Char], GValue) constructActivatableUseActionAppearance val = constructObjectPropertyBool "use-action-appearance" val data ActivatableUseActionAppearancePropertyInfo instance AttrInfo ActivatableUseActionAppearancePropertyInfo where type AttrAllowedOps ActivatableUseActionAppearancePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ActivatableUseActionAppearancePropertyInfo = (~) Bool type AttrBaseTypeConstraint ActivatableUseActionAppearancePropertyInfo = ActivatableK type AttrGetType ActivatableUseActionAppearancePropertyInfo = Bool type AttrLabel ActivatableUseActionAppearancePropertyInfo = "Activatable::use-action-appearance" attrGet _ = getActivatableUseActionAppearance attrSet _ = setActivatableUseActionAppearance attrConstruct _ = constructActivatableUseActionAppearance type instance AttributeList Activatable = '[ '("related-action", ActivatableRelatedActionPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo)] -- VVV Prop "lower" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getAdjustmentLower :: (MonadIO m, AdjustmentK o) => o -> m Double getAdjustmentLower obj = liftIO $ getObjectPropertyDouble obj "lower" setAdjustmentLower :: (MonadIO m, AdjustmentK o) => o -> Double -> m () setAdjustmentLower obj val = liftIO $ setObjectPropertyDouble obj "lower" val constructAdjustmentLower :: Double -> IO ([Char], GValue) constructAdjustmentLower val = constructObjectPropertyDouble "lower" val data AdjustmentLowerPropertyInfo instance AttrInfo AdjustmentLowerPropertyInfo where type AttrAllowedOps AdjustmentLowerPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AdjustmentLowerPropertyInfo = (~) Double type AttrBaseTypeConstraint AdjustmentLowerPropertyInfo = AdjustmentK type AttrGetType AdjustmentLowerPropertyInfo = Double type AttrLabel AdjustmentLowerPropertyInfo = "Adjustment::lower" attrGet _ = getAdjustmentLower attrSet _ = setAdjustmentLower attrConstruct _ = constructAdjustmentLower -- VVV Prop "page-increment" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getAdjustmentPageIncrement :: (MonadIO m, AdjustmentK o) => o -> m Double getAdjustmentPageIncrement obj = liftIO $ getObjectPropertyDouble obj "page-increment" setAdjustmentPageIncrement :: (MonadIO m, AdjustmentK o) => o -> Double -> m () setAdjustmentPageIncrement obj val = liftIO $ setObjectPropertyDouble obj "page-increment" val constructAdjustmentPageIncrement :: Double -> IO ([Char], GValue) constructAdjustmentPageIncrement val = constructObjectPropertyDouble "page-increment" val data AdjustmentPageIncrementPropertyInfo instance AttrInfo AdjustmentPageIncrementPropertyInfo where type AttrAllowedOps AdjustmentPageIncrementPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AdjustmentPageIncrementPropertyInfo = (~) Double type AttrBaseTypeConstraint AdjustmentPageIncrementPropertyInfo = AdjustmentK type AttrGetType AdjustmentPageIncrementPropertyInfo = Double type AttrLabel AdjustmentPageIncrementPropertyInfo = "Adjustment::page-increment" attrGet _ = getAdjustmentPageIncrement attrSet _ = setAdjustmentPageIncrement attrConstruct _ = constructAdjustmentPageIncrement -- VVV Prop "page-size" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getAdjustmentPageSize :: (MonadIO m, AdjustmentK o) => o -> m Double getAdjustmentPageSize obj = liftIO $ getObjectPropertyDouble obj "page-size" setAdjustmentPageSize :: (MonadIO m, AdjustmentK o) => o -> Double -> m () setAdjustmentPageSize obj val = liftIO $ setObjectPropertyDouble obj "page-size" val constructAdjustmentPageSize :: Double -> IO ([Char], GValue) constructAdjustmentPageSize val = constructObjectPropertyDouble "page-size" val data AdjustmentPageSizePropertyInfo instance AttrInfo AdjustmentPageSizePropertyInfo where type AttrAllowedOps AdjustmentPageSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AdjustmentPageSizePropertyInfo = (~) Double type AttrBaseTypeConstraint AdjustmentPageSizePropertyInfo = AdjustmentK type AttrGetType AdjustmentPageSizePropertyInfo = Double type AttrLabel AdjustmentPageSizePropertyInfo = "Adjustment::page-size" attrGet _ = getAdjustmentPageSize attrSet _ = setAdjustmentPageSize attrConstruct _ = constructAdjustmentPageSize -- VVV Prop "step-increment" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getAdjustmentStepIncrement :: (MonadIO m, AdjustmentK o) => o -> m Double getAdjustmentStepIncrement obj = liftIO $ getObjectPropertyDouble obj "step-increment" setAdjustmentStepIncrement :: (MonadIO m, AdjustmentK o) => o -> Double -> m () setAdjustmentStepIncrement obj val = liftIO $ setObjectPropertyDouble obj "step-increment" val constructAdjustmentStepIncrement :: Double -> IO ([Char], GValue) constructAdjustmentStepIncrement val = constructObjectPropertyDouble "step-increment" val data AdjustmentStepIncrementPropertyInfo instance AttrInfo AdjustmentStepIncrementPropertyInfo where type AttrAllowedOps AdjustmentStepIncrementPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AdjustmentStepIncrementPropertyInfo = (~) Double type AttrBaseTypeConstraint AdjustmentStepIncrementPropertyInfo = AdjustmentK type AttrGetType AdjustmentStepIncrementPropertyInfo = Double type AttrLabel AdjustmentStepIncrementPropertyInfo = "Adjustment::step-increment" attrGet _ = getAdjustmentStepIncrement attrSet _ = setAdjustmentStepIncrement attrConstruct _ = constructAdjustmentStepIncrement -- VVV Prop "upper" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getAdjustmentUpper :: (MonadIO m, AdjustmentK o) => o -> m Double getAdjustmentUpper obj = liftIO $ getObjectPropertyDouble obj "upper" setAdjustmentUpper :: (MonadIO m, AdjustmentK o) => o -> Double -> m () setAdjustmentUpper obj val = liftIO $ setObjectPropertyDouble obj "upper" val constructAdjustmentUpper :: Double -> IO ([Char], GValue) constructAdjustmentUpper val = constructObjectPropertyDouble "upper" val data AdjustmentUpperPropertyInfo instance AttrInfo AdjustmentUpperPropertyInfo where type AttrAllowedOps AdjustmentUpperPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AdjustmentUpperPropertyInfo = (~) Double type AttrBaseTypeConstraint AdjustmentUpperPropertyInfo = AdjustmentK type AttrGetType AdjustmentUpperPropertyInfo = Double type AttrLabel AdjustmentUpperPropertyInfo = "Adjustment::upper" attrGet _ = getAdjustmentUpper attrSet _ = setAdjustmentUpper attrConstruct _ = constructAdjustmentUpper -- VVV Prop "value" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getAdjustmentValue :: (MonadIO m, AdjustmentK o) => o -> m Double getAdjustmentValue obj = liftIO $ getObjectPropertyDouble obj "value" setAdjustmentValue :: (MonadIO m, AdjustmentK o) => o -> Double -> m () setAdjustmentValue obj val = liftIO $ setObjectPropertyDouble obj "value" val constructAdjustmentValue :: Double -> IO ([Char], GValue) constructAdjustmentValue val = constructObjectPropertyDouble "value" val data AdjustmentValuePropertyInfo instance AttrInfo AdjustmentValuePropertyInfo where type AttrAllowedOps AdjustmentValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AdjustmentValuePropertyInfo = (~) Double type AttrBaseTypeConstraint AdjustmentValuePropertyInfo = AdjustmentK type AttrGetType AdjustmentValuePropertyInfo = Double type AttrLabel AdjustmentValuePropertyInfo = "Adjustment::value" attrGet _ = getAdjustmentValue attrSet _ = setAdjustmentValue attrConstruct _ = constructAdjustmentValue type instance AttributeList Adjustment = '[ '("lower", AdjustmentLowerPropertyInfo), '("page-increment", AdjustmentPageIncrementPropertyInfo), '("page-size", AdjustmentPageSizePropertyInfo), '("step-increment", AdjustmentStepIncrementPropertyInfo), '("upper", AdjustmentUpperPropertyInfo), '("value", AdjustmentValuePropertyInfo)] -- VVV Prop "bottom-padding" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getAlignmentBottomPadding :: (MonadIO m, AlignmentK o) => o -> m Word32 getAlignmentBottomPadding obj = liftIO $ getObjectPropertyCUInt obj "bottom-padding" setAlignmentBottomPadding :: (MonadIO m, AlignmentK o) => o -> Word32 -> m () setAlignmentBottomPadding obj val = liftIO $ setObjectPropertyCUInt obj "bottom-padding" val constructAlignmentBottomPadding :: Word32 -> IO ([Char], GValue) constructAlignmentBottomPadding val = constructObjectPropertyCUInt "bottom-padding" val data AlignmentBottomPaddingPropertyInfo instance AttrInfo AlignmentBottomPaddingPropertyInfo where type AttrAllowedOps AlignmentBottomPaddingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AlignmentBottomPaddingPropertyInfo = (~) Word32 type AttrBaseTypeConstraint AlignmentBottomPaddingPropertyInfo = AlignmentK type AttrGetType AlignmentBottomPaddingPropertyInfo = Word32 type AttrLabel AlignmentBottomPaddingPropertyInfo = "Alignment::bottom-padding" attrGet _ = getAlignmentBottomPadding attrSet _ = setAlignmentBottomPadding attrConstruct _ = constructAlignmentBottomPadding -- VVV Prop "left-padding" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getAlignmentLeftPadding :: (MonadIO m, AlignmentK o) => o -> m Word32 getAlignmentLeftPadding obj = liftIO $ getObjectPropertyCUInt obj "left-padding" setAlignmentLeftPadding :: (MonadIO m, AlignmentK o) => o -> Word32 -> m () setAlignmentLeftPadding obj val = liftIO $ setObjectPropertyCUInt obj "left-padding" val constructAlignmentLeftPadding :: Word32 -> IO ([Char], GValue) constructAlignmentLeftPadding val = constructObjectPropertyCUInt "left-padding" val data AlignmentLeftPaddingPropertyInfo instance AttrInfo AlignmentLeftPaddingPropertyInfo where type AttrAllowedOps AlignmentLeftPaddingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AlignmentLeftPaddingPropertyInfo = (~) Word32 type AttrBaseTypeConstraint AlignmentLeftPaddingPropertyInfo = AlignmentK type AttrGetType AlignmentLeftPaddingPropertyInfo = Word32 type AttrLabel AlignmentLeftPaddingPropertyInfo = "Alignment::left-padding" attrGet _ = getAlignmentLeftPadding attrSet _ = setAlignmentLeftPadding attrConstruct _ = constructAlignmentLeftPadding -- VVV Prop "right-padding" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getAlignmentRightPadding :: (MonadIO m, AlignmentK o) => o -> m Word32 getAlignmentRightPadding obj = liftIO $ getObjectPropertyCUInt obj "right-padding" setAlignmentRightPadding :: (MonadIO m, AlignmentK o) => o -> Word32 -> m () setAlignmentRightPadding obj val = liftIO $ setObjectPropertyCUInt obj "right-padding" val constructAlignmentRightPadding :: Word32 -> IO ([Char], GValue) constructAlignmentRightPadding val = constructObjectPropertyCUInt "right-padding" val data AlignmentRightPaddingPropertyInfo instance AttrInfo AlignmentRightPaddingPropertyInfo where type AttrAllowedOps AlignmentRightPaddingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AlignmentRightPaddingPropertyInfo = (~) Word32 type AttrBaseTypeConstraint AlignmentRightPaddingPropertyInfo = AlignmentK type AttrGetType AlignmentRightPaddingPropertyInfo = Word32 type AttrLabel AlignmentRightPaddingPropertyInfo = "Alignment::right-padding" attrGet _ = getAlignmentRightPadding attrSet _ = setAlignmentRightPadding attrConstruct _ = constructAlignmentRightPadding -- VVV Prop "top-padding" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getAlignmentTopPadding :: (MonadIO m, AlignmentK o) => o -> m Word32 getAlignmentTopPadding obj = liftIO $ getObjectPropertyCUInt obj "top-padding" setAlignmentTopPadding :: (MonadIO m, AlignmentK o) => o -> Word32 -> m () setAlignmentTopPadding obj val = liftIO $ setObjectPropertyCUInt obj "top-padding" val constructAlignmentTopPadding :: Word32 -> IO ([Char], GValue) constructAlignmentTopPadding val = constructObjectPropertyCUInt "top-padding" val data AlignmentTopPaddingPropertyInfo instance AttrInfo AlignmentTopPaddingPropertyInfo where type AttrAllowedOps AlignmentTopPaddingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AlignmentTopPaddingPropertyInfo = (~) Word32 type AttrBaseTypeConstraint AlignmentTopPaddingPropertyInfo = AlignmentK type AttrGetType AlignmentTopPaddingPropertyInfo = Word32 type AttrLabel AlignmentTopPaddingPropertyInfo = "Alignment::top-padding" attrGet _ = getAlignmentTopPadding attrSet _ = setAlignmentTopPadding attrConstruct _ = constructAlignmentTopPadding -- VVV Prop "xalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getAlignmentXalign :: (MonadIO m, AlignmentK o) => o -> m Float getAlignmentXalign obj = liftIO $ getObjectPropertyFloat obj "xalign" setAlignmentXalign :: (MonadIO m, AlignmentK o) => o -> Float -> m () setAlignmentXalign obj val = liftIO $ setObjectPropertyFloat obj "xalign" val constructAlignmentXalign :: Float -> IO ([Char], GValue) constructAlignmentXalign val = constructObjectPropertyFloat "xalign" val data AlignmentXalignPropertyInfo instance AttrInfo AlignmentXalignPropertyInfo where type AttrAllowedOps AlignmentXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AlignmentXalignPropertyInfo = (~) Float type AttrBaseTypeConstraint AlignmentXalignPropertyInfo = AlignmentK type AttrGetType AlignmentXalignPropertyInfo = Float type AttrLabel AlignmentXalignPropertyInfo = "Alignment::xalign" attrGet _ = getAlignmentXalign attrSet _ = setAlignmentXalign attrConstruct _ = constructAlignmentXalign -- VVV Prop "xscale" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getAlignmentXscale :: (MonadIO m, AlignmentK o) => o -> m Float getAlignmentXscale obj = liftIO $ getObjectPropertyFloat obj "xscale" setAlignmentXscale :: (MonadIO m, AlignmentK o) => o -> Float -> m () setAlignmentXscale obj val = liftIO $ setObjectPropertyFloat obj "xscale" val constructAlignmentXscale :: Float -> IO ([Char], GValue) constructAlignmentXscale val = constructObjectPropertyFloat "xscale" val data AlignmentXscalePropertyInfo instance AttrInfo AlignmentXscalePropertyInfo where type AttrAllowedOps AlignmentXscalePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AlignmentXscalePropertyInfo = (~) Float type AttrBaseTypeConstraint AlignmentXscalePropertyInfo = AlignmentK type AttrGetType AlignmentXscalePropertyInfo = Float type AttrLabel AlignmentXscalePropertyInfo = "Alignment::xscale" attrGet _ = getAlignmentXscale attrSet _ = setAlignmentXscale attrConstruct _ = constructAlignmentXscale -- VVV Prop "yalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getAlignmentYalign :: (MonadIO m, AlignmentK o) => o -> m Float getAlignmentYalign obj = liftIO $ getObjectPropertyFloat obj "yalign" setAlignmentYalign :: (MonadIO m, AlignmentK o) => o -> Float -> m () setAlignmentYalign obj val = liftIO $ setObjectPropertyFloat obj "yalign" val constructAlignmentYalign :: Float -> IO ([Char], GValue) constructAlignmentYalign val = constructObjectPropertyFloat "yalign" val data AlignmentYalignPropertyInfo instance AttrInfo AlignmentYalignPropertyInfo where type AttrAllowedOps AlignmentYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AlignmentYalignPropertyInfo = (~) Float type AttrBaseTypeConstraint AlignmentYalignPropertyInfo = AlignmentK type AttrGetType AlignmentYalignPropertyInfo = Float type AttrLabel AlignmentYalignPropertyInfo = "Alignment::yalign" attrGet _ = getAlignmentYalign attrSet _ = setAlignmentYalign attrConstruct _ = constructAlignmentYalign -- VVV Prop "yscale" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getAlignmentYscale :: (MonadIO m, AlignmentK o) => o -> m Float getAlignmentYscale obj = liftIO $ getObjectPropertyFloat obj "yscale" setAlignmentYscale :: (MonadIO m, AlignmentK o) => o -> Float -> m () setAlignmentYscale obj val = liftIO $ setObjectPropertyFloat obj "yscale" val constructAlignmentYscale :: Float -> IO ([Char], GValue) constructAlignmentYscale val = constructObjectPropertyFloat "yscale" val data AlignmentYscalePropertyInfo instance AttrInfo AlignmentYscalePropertyInfo where type AttrAllowedOps AlignmentYscalePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AlignmentYscalePropertyInfo = (~) Float type AttrBaseTypeConstraint AlignmentYscalePropertyInfo = AlignmentK type AttrGetType AlignmentYscalePropertyInfo = Float type AttrLabel AlignmentYscalePropertyInfo = "Alignment::yscale" attrGet _ = getAlignmentYscale attrSet _ = setAlignmentYscale attrConstruct _ = constructAlignmentYscale type instance AttributeList Alignment = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("bottom-padding", AlignmentBottomPaddingPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("left-padding", AlignmentLeftPaddingPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("right-padding", AlignmentRightPaddingPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("top-padding", AlignmentTopPaddingPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", AlignmentXalignPropertyInfo), '("xscale", AlignmentXscalePropertyInfo), '("yalign", AlignmentYalignPropertyInfo), '("yscale", AlignmentYscalePropertyInfo)] -- VVV Prop "content-type" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getAppChooserContentType :: (MonadIO m, AppChooserK o) => o -> m T.Text getAppChooserContentType obj = liftIO $ getObjectPropertyString obj "content-type" constructAppChooserContentType :: T.Text -> IO ([Char], GValue) constructAppChooserContentType val = constructObjectPropertyString "content-type" val data AppChooserContentTypePropertyInfo instance AttrInfo AppChooserContentTypePropertyInfo where type AttrAllowedOps AppChooserContentTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserContentTypePropertyInfo = (~) T.Text type AttrBaseTypeConstraint AppChooserContentTypePropertyInfo = AppChooserK type AttrGetType AppChooserContentTypePropertyInfo = T.Text type AttrLabel AppChooserContentTypePropertyInfo = "AppChooser::content-type" attrGet _ = getAppChooserContentType attrSet _ = undefined attrConstruct _ = constructAppChooserContentType type instance AttributeList AppChooser = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("content-type", AppChooserContentTypePropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "heading" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAppChooserButtonHeading :: (MonadIO m, AppChooserButtonK o) => o -> m T.Text getAppChooserButtonHeading obj = liftIO $ getObjectPropertyString obj "heading" setAppChooserButtonHeading :: (MonadIO m, AppChooserButtonK o) => o -> T.Text -> m () setAppChooserButtonHeading obj val = liftIO $ setObjectPropertyString obj "heading" val constructAppChooserButtonHeading :: T.Text -> IO ([Char], GValue) constructAppChooserButtonHeading val = constructObjectPropertyString "heading" val data AppChooserButtonHeadingPropertyInfo instance AttrInfo AppChooserButtonHeadingPropertyInfo where type AttrAllowedOps AppChooserButtonHeadingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserButtonHeadingPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AppChooserButtonHeadingPropertyInfo = AppChooserButtonK type AttrGetType AppChooserButtonHeadingPropertyInfo = T.Text type AttrLabel AppChooserButtonHeadingPropertyInfo = "AppChooserButton::heading" attrGet _ = getAppChooserButtonHeading attrSet _ = setAppChooserButtonHeading attrConstruct _ = constructAppChooserButtonHeading -- VVV Prop "show-default-item" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getAppChooserButtonShowDefaultItem :: (MonadIO m, AppChooserButtonK o) => o -> m Bool getAppChooserButtonShowDefaultItem obj = liftIO $ getObjectPropertyBool obj "show-default-item" setAppChooserButtonShowDefaultItem :: (MonadIO m, AppChooserButtonK o) => o -> Bool -> m () setAppChooserButtonShowDefaultItem obj val = liftIO $ setObjectPropertyBool obj "show-default-item" val constructAppChooserButtonShowDefaultItem :: Bool -> IO ([Char], GValue) constructAppChooserButtonShowDefaultItem val = constructObjectPropertyBool "show-default-item" val data AppChooserButtonShowDefaultItemPropertyInfo instance AttrInfo AppChooserButtonShowDefaultItemPropertyInfo where type AttrAllowedOps AppChooserButtonShowDefaultItemPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserButtonShowDefaultItemPropertyInfo = (~) Bool type AttrBaseTypeConstraint AppChooserButtonShowDefaultItemPropertyInfo = AppChooserButtonK type AttrGetType AppChooserButtonShowDefaultItemPropertyInfo = Bool type AttrLabel AppChooserButtonShowDefaultItemPropertyInfo = "AppChooserButton::show-default-item" attrGet _ = getAppChooserButtonShowDefaultItem attrSet _ = setAppChooserButtonShowDefaultItem attrConstruct _ = constructAppChooserButtonShowDefaultItem -- VVV Prop "show-dialog-item" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getAppChooserButtonShowDialogItem :: (MonadIO m, AppChooserButtonK o) => o -> m Bool getAppChooserButtonShowDialogItem obj = liftIO $ getObjectPropertyBool obj "show-dialog-item" setAppChooserButtonShowDialogItem :: (MonadIO m, AppChooserButtonK o) => o -> Bool -> m () setAppChooserButtonShowDialogItem obj val = liftIO $ setObjectPropertyBool obj "show-dialog-item" val constructAppChooserButtonShowDialogItem :: Bool -> IO ([Char], GValue) constructAppChooserButtonShowDialogItem val = constructObjectPropertyBool "show-dialog-item" val data AppChooserButtonShowDialogItemPropertyInfo instance AttrInfo AppChooserButtonShowDialogItemPropertyInfo where type AttrAllowedOps AppChooserButtonShowDialogItemPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserButtonShowDialogItemPropertyInfo = (~) Bool type AttrBaseTypeConstraint AppChooserButtonShowDialogItemPropertyInfo = AppChooserButtonK type AttrGetType AppChooserButtonShowDialogItemPropertyInfo = Bool type AttrLabel AppChooserButtonShowDialogItemPropertyInfo = "AppChooserButton::show-dialog-item" attrGet _ = getAppChooserButtonShowDialogItem attrSet _ = setAppChooserButtonShowDialogItem attrConstruct _ = constructAppChooserButtonShowDialogItem type instance AttributeList AppChooserButton = '[ '("active", ComboBoxActivePropertyInfo), '("active-id", ComboBoxActiveIdPropertyInfo), '("add-tearoffs", ComboBoxAddTearoffsPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("button-sensitivity", ComboBoxButtonSensitivityPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("cell-area", ComboBoxCellAreaPropertyInfo), '("child", ContainerChildPropertyInfo), '("column-span-column", ComboBoxColumnSpanColumnPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("content-type", AppChooserContentTypePropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("editing-canceled", CellEditableEditingCanceledPropertyInfo), '("entry-text-column", ComboBoxEntryTextColumnPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ComboBoxFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-entry", ComboBoxHasEntryPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-frame", ComboBoxHasFramePropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("heading", AppChooserButtonHeadingPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("id-column", ComboBoxIdColumnPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("model", ComboBoxModelPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("popup-fixed-width", ComboBoxPopupFixedWidthPropertyInfo), '("popup-shown", ComboBoxPopupShownPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("row-span-column", ComboBoxRowSpanColumnPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-default-item", AppChooserButtonShowDefaultItemPropertyInfo), '("show-dialog-item", AppChooserButtonShowDialogItemPropertyInfo), '("style", WidgetStylePropertyInfo), '("tearoff-title", ComboBoxTearoffTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("wrap-width", ComboBoxWrapWidthPropertyInfo)] -- VVV Prop "gfile" -- Type: TInterface "Gio" "File" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getAppChooserDialogGfile :: (MonadIO m, AppChooserDialogK o) => o -> m Gio.File getAppChooserDialogGfile obj = liftIO $ getObjectPropertyObject obj "gfile" Gio.File constructAppChooserDialogGfile :: (Gio.FileK a) => a -> IO ([Char], GValue) constructAppChooserDialogGfile val = constructObjectPropertyObject "gfile" val data AppChooserDialogGfilePropertyInfo instance AttrInfo AppChooserDialogGfilePropertyInfo where type AttrAllowedOps AppChooserDialogGfilePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserDialogGfilePropertyInfo = Gio.FileK type AttrBaseTypeConstraint AppChooserDialogGfilePropertyInfo = AppChooserDialogK type AttrGetType AppChooserDialogGfilePropertyInfo = Gio.File type AttrLabel AppChooserDialogGfilePropertyInfo = "AppChooserDialog::gfile" attrGet _ = getAppChooserDialogGfile attrSet _ = undefined attrConstruct _ = constructAppChooserDialogGfile -- VVV Prop "heading" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAppChooserDialogHeading :: (MonadIO m, AppChooserDialogK o) => o -> m T.Text getAppChooserDialogHeading obj = liftIO $ getObjectPropertyString obj "heading" setAppChooserDialogHeading :: (MonadIO m, AppChooserDialogK o) => o -> T.Text -> m () setAppChooserDialogHeading obj val = liftIO $ setObjectPropertyString obj "heading" val constructAppChooserDialogHeading :: T.Text -> IO ([Char], GValue) constructAppChooserDialogHeading val = constructObjectPropertyString "heading" val data AppChooserDialogHeadingPropertyInfo instance AttrInfo AppChooserDialogHeadingPropertyInfo where type AttrAllowedOps AppChooserDialogHeadingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserDialogHeadingPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AppChooserDialogHeadingPropertyInfo = AppChooserDialogK type AttrGetType AppChooserDialogHeadingPropertyInfo = T.Text type AttrLabel AppChooserDialogHeadingPropertyInfo = "AppChooserDialog::heading" attrGet _ = getAppChooserDialogHeading attrSet _ = setAppChooserDialogHeading attrConstruct _ = constructAppChooserDialogHeading type instance AttributeList AppChooserDialog = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("content-type", AppChooserContentTypePropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gfile", AppChooserDialogGfilePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("heading", AppChooserDialogHeadingPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-header-bar", DialogUseHeaderBarPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] -- VVV Prop "default-text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAppChooserWidgetDefaultText :: (MonadIO m, AppChooserWidgetK o) => o -> m T.Text getAppChooserWidgetDefaultText obj = liftIO $ getObjectPropertyString obj "default-text" setAppChooserWidgetDefaultText :: (MonadIO m, AppChooserWidgetK o) => o -> T.Text -> m () setAppChooserWidgetDefaultText obj val = liftIO $ setObjectPropertyString obj "default-text" val constructAppChooserWidgetDefaultText :: T.Text -> IO ([Char], GValue) constructAppChooserWidgetDefaultText val = constructObjectPropertyString "default-text" val data AppChooserWidgetDefaultTextPropertyInfo instance AttrInfo AppChooserWidgetDefaultTextPropertyInfo where type AttrAllowedOps AppChooserWidgetDefaultTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserWidgetDefaultTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AppChooserWidgetDefaultTextPropertyInfo = AppChooserWidgetK type AttrGetType AppChooserWidgetDefaultTextPropertyInfo = T.Text type AttrLabel AppChooserWidgetDefaultTextPropertyInfo = "AppChooserWidget::default-text" attrGet _ = getAppChooserWidgetDefaultText attrSet _ = setAppChooserWidgetDefaultText attrConstruct _ = constructAppChooserWidgetDefaultText -- VVV Prop "show-all" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getAppChooserWidgetShowAll :: (MonadIO m, AppChooserWidgetK o) => o -> m Bool getAppChooserWidgetShowAll obj = liftIO $ getObjectPropertyBool obj "show-all" setAppChooserWidgetShowAll :: (MonadIO m, AppChooserWidgetK o) => o -> Bool -> m () setAppChooserWidgetShowAll obj val = liftIO $ setObjectPropertyBool obj "show-all" val constructAppChooserWidgetShowAll :: Bool -> IO ([Char], GValue) constructAppChooserWidgetShowAll val = constructObjectPropertyBool "show-all" val data AppChooserWidgetShowAllPropertyInfo instance AttrInfo AppChooserWidgetShowAllPropertyInfo where type AttrAllowedOps AppChooserWidgetShowAllPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserWidgetShowAllPropertyInfo = (~) Bool type AttrBaseTypeConstraint AppChooserWidgetShowAllPropertyInfo = AppChooserWidgetK type AttrGetType AppChooserWidgetShowAllPropertyInfo = Bool type AttrLabel AppChooserWidgetShowAllPropertyInfo = "AppChooserWidget::show-all" attrGet _ = getAppChooserWidgetShowAll attrSet _ = setAppChooserWidgetShowAll attrConstruct _ = constructAppChooserWidgetShowAll -- VVV Prop "show-default" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getAppChooserWidgetShowDefault :: (MonadIO m, AppChooserWidgetK o) => o -> m Bool getAppChooserWidgetShowDefault obj = liftIO $ getObjectPropertyBool obj "show-default" setAppChooserWidgetShowDefault :: (MonadIO m, AppChooserWidgetK o) => o -> Bool -> m () setAppChooserWidgetShowDefault obj val = liftIO $ setObjectPropertyBool obj "show-default" val constructAppChooserWidgetShowDefault :: Bool -> IO ([Char], GValue) constructAppChooserWidgetShowDefault val = constructObjectPropertyBool "show-default" val data AppChooserWidgetShowDefaultPropertyInfo instance AttrInfo AppChooserWidgetShowDefaultPropertyInfo where type AttrAllowedOps AppChooserWidgetShowDefaultPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserWidgetShowDefaultPropertyInfo = (~) Bool type AttrBaseTypeConstraint AppChooserWidgetShowDefaultPropertyInfo = AppChooserWidgetK type AttrGetType AppChooserWidgetShowDefaultPropertyInfo = Bool type AttrLabel AppChooserWidgetShowDefaultPropertyInfo = "AppChooserWidget::show-default" attrGet _ = getAppChooserWidgetShowDefault attrSet _ = setAppChooserWidgetShowDefault attrConstruct _ = constructAppChooserWidgetShowDefault -- VVV Prop "show-fallback" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getAppChooserWidgetShowFallback :: (MonadIO m, AppChooserWidgetK o) => o -> m Bool getAppChooserWidgetShowFallback obj = liftIO $ getObjectPropertyBool obj "show-fallback" setAppChooserWidgetShowFallback :: (MonadIO m, AppChooserWidgetK o) => o -> Bool -> m () setAppChooserWidgetShowFallback obj val = liftIO $ setObjectPropertyBool obj "show-fallback" val constructAppChooserWidgetShowFallback :: Bool -> IO ([Char], GValue) constructAppChooserWidgetShowFallback val = constructObjectPropertyBool "show-fallback" val data AppChooserWidgetShowFallbackPropertyInfo instance AttrInfo AppChooserWidgetShowFallbackPropertyInfo where type AttrAllowedOps AppChooserWidgetShowFallbackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserWidgetShowFallbackPropertyInfo = (~) Bool type AttrBaseTypeConstraint AppChooserWidgetShowFallbackPropertyInfo = AppChooserWidgetK type AttrGetType AppChooserWidgetShowFallbackPropertyInfo = Bool type AttrLabel AppChooserWidgetShowFallbackPropertyInfo = "AppChooserWidget::show-fallback" attrGet _ = getAppChooserWidgetShowFallback attrSet _ = setAppChooserWidgetShowFallback attrConstruct _ = constructAppChooserWidgetShowFallback -- VVV Prop "show-other" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getAppChooserWidgetShowOther :: (MonadIO m, AppChooserWidgetK o) => o -> m Bool getAppChooserWidgetShowOther obj = liftIO $ getObjectPropertyBool obj "show-other" setAppChooserWidgetShowOther :: (MonadIO m, AppChooserWidgetK o) => o -> Bool -> m () setAppChooserWidgetShowOther obj val = liftIO $ setObjectPropertyBool obj "show-other" val constructAppChooserWidgetShowOther :: Bool -> IO ([Char], GValue) constructAppChooserWidgetShowOther val = constructObjectPropertyBool "show-other" val data AppChooserWidgetShowOtherPropertyInfo instance AttrInfo AppChooserWidgetShowOtherPropertyInfo where type AttrAllowedOps AppChooserWidgetShowOtherPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserWidgetShowOtherPropertyInfo = (~) Bool type AttrBaseTypeConstraint AppChooserWidgetShowOtherPropertyInfo = AppChooserWidgetK type AttrGetType AppChooserWidgetShowOtherPropertyInfo = Bool type AttrLabel AppChooserWidgetShowOtherPropertyInfo = "AppChooserWidget::show-other" attrGet _ = getAppChooserWidgetShowOther attrSet _ = setAppChooserWidgetShowOther attrConstruct _ = constructAppChooserWidgetShowOther -- VVV Prop "show-recommended" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getAppChooserWidgetShowRecommended :: (MonadIO m, AppChooserWidgetK o) => o -> m Bool getAppChooserWidgetShowRecommended obj = liftIO $ getObjectPropertyBool obj "show-recommended" setAppChooserWidgetShowRecommended :: (MonadIO m, AppChooserWidgetK o) => o -> Bool -> m () setAppChooserWidgetShowRecommended obj val = liftIO $ setObjectPropertyBool obj "show-recommended" val constructAppChooserWidgetShowRecommended :: Bool -> IO ([Char], GValue) constructAppChooserWidgetShowRecommended val = constructObjectPropertyBool "show-recommended" val data AppChooserWidgetShowRecommendedPropertyInfo instance AttrInfo AppChooserWidgetShowRecommendedPropertyInfo where type AttrAllowedOps AppChooserWidgetShowRecommendedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AppChooserWidgetShowRecommendedPropertyInfo = (~) Bool type AttrBaseTypeConstraint AppChooserWidgetShowRecommendedPropertyInfo = AppChooserWidgetK type AttrGetType AppChooserWidgetShowRecommendedPropertyInfo = Bool type AttrLabel AppChooserWidgetShowRecommendedPropertyInfo = "AppChooserWidget::show-recommended" attrGet _ = getAppChooserWidgetShowRecommended attrSet _ = setAppChooserWidgetShowRecommended attrConstruct _ = constructAppChooserWidgetShowRecommended type instance AttributeList AppChooserWidget = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("content-type", AppChooserContentTypePropertyInfo), '("default-text", AppChooserWidgetDefaultTextPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-all", AppChooserWidgetShowAllPropertyInfo), '("show-default", AppChooserWidgetShowDefaultPropertyInfo), '("show-fallback", AppChooserWidgetShowFallbackPropertyInfo), '("show-other", AppChooserWidgetShowOtherPropertyInfo), '("show-recommended", AppChooserWidgetShowRecommendedPropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "active-window" -- Type: TInterface "Gtk" "Window" -- Flags: [PropertyReadable] getApplicationActiveWindow :: (MonadIO m, ApplicationK o) => o -> m Window getApplicationActiveWindow obj = liftIO $ getObjectPropertyObject obj "active-window" Window data ApplicationActiveWindowPropertyInfo instance AttrInfo ApplicationActiveWindowPropertyInfo where type AttrAllowedOps ApplicationActiveWindowPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ApplicationActiveWindowPropertyInfo = (~) () type AttrBaseTypeConstraint ApplicationActiveWindowPropertyInfo = ApplicationK type AttrGetType ApplicationActiveWindowPropertyInfo = Window type AttrLabel ApplicationActiveWindowPropertyInfo = "Application::active-window" attrGet _ = getApplicationActiveWindow attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "app-menu" -- Type: TInterface "Gio" "MenuModel" -- Flags: [PropertyReadable,PropertyWritable] getApplicationAppMenu :: (MonadIO m, ApplicationK o) => o -> m Gio.MenuModel getApplicationAppMenu obj = liftIO $ getObjectPropertyObject obj "app-menu" Gio.MenuModel setApplicationAppMenu :: (MonadIO m, ApplicationK o, Gio.MenuModelK a) => o -> a -> m () setApplicationAppMenu obj val = liftIO $ setObjectPropertyObject obj "app-menu" val constructApplicationAppMenu :: (Gio.MenuModelK a) => a -> IO ([Char], GValue) constructApplicationAppMenu val = constructObjectPropertyObject "app-menu" val data ApplicationAppMenuPropertyInfo instance AttrInfo ApplicationAppMenuPropertyInfo where type AttrAllowedOps ApplicationAppMenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ApplicationAppMenuPropertyInfo = Gio.MenuModelK type AttrBaseTypeConstraint ApplicationAppMenuPropertyInfo = ApplicationK type AttrGetType ApplicationAppMenuPropertyInfo = Gio.MenuModel type AttrLabel ApplicationAppMenuPropertyInfo = "Application::app-menu" attrGet _ = getApplicationAppMenu attrSet _ = setApplicationAppMenu attrConstruct _ = constructApplicationAppMenu -- VVV Prop "menubar" -- Type: TInterface "Gio" "MenuModel" -- Flags: [PropertyReadable,PropertyWritable] getApplicationMenubar :: (MonadIO m, ApplicationK o) => o -> m Gio.MenuModel getApplicationMenubar obj = liftIO $ getObjectPropertyObject obj "menubar" Gio.MenuModel setApplicationMenubar :: (MonadIO m, ApplicationK o, Gio.MenuModelK a) => o -> a -> m () setApplicationMenubar obj val = liftIO $ setObjectPropertyObject obj "menubar" val constructApplicationMenubar :: (Gio.MenuModelK a) => a -> IO ([Char], GValue) constructApplicationMenubar val = constructObjectPropertyObject "menubar" val data ApplicationMenubarPropertyInfo instance AttrInfo ApplicationMenubarPropertyInfo where type AttrAllowedOps ApplicationMenubarPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ApplicationMenubarPropertyInfo = Gio.MenuModelK type AttrBaseTypeConstraint ApplicationMenubarPropertyInfo = ApplicationK type AttrGetType ApplicationMenubarPropertyInfo = Gio.MenuModel type AttrLabel ApplicationMenubarPropertyInfo = "Application::menubar" attrGet _ = getApplicationMenubar attrSet _ = setApplicationMenubar attrConstruct _ = constructApplicationMenubar -- VVV Prop "register-session" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getApplicationRegisterSession :: (MonadIO m, ApplicationK o) => o -> m Bool getApplicationRegisterSession obj = liftIO $ getObjectPropertyBool obj "register-session" setApplicationRegisterSession :: (MonadIO m, ApplicationK o) => o -> Bool -> m () setApplicationRegisterSession obj val = liftIO $ setObjectPropertyBool obj "register-session" val constructApplicationRegisterSession :: Bool -> IO ([Char], GValue) constructApplicationRegisterSession val = constructObjectPropertyBool "register-session" val data ApplicationRegisterSessionPropertyInfo instance AttrInfo ApplicationRegisterSessionPropertyInfo where type AttrAllowedOps ApplicationRegisterSessionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ApplicationRegisterSessionPropertyInfo = (~) Bool type AttrBaseTypeConstraint ApplicationRegisterSessionPropertyInfo = ApplicationK type AttrGetType ApplicationRegisterSessionPropertyInfo = Bool type AttrLabel ApplicationRegisterSessionPropertyInfo = "Application::register-session" attrGet _ = getApplicationRegisterSession attrSet _ = setApplicationRegisterSession attrConstruct _ = constructApplicationRegisterSession type instance AttributeList Application = '[ '("action-group", GioA.ApplicationActionGroupPropertyInfo), '("active-window", ApplicationActiveWindowPropertyInfo), '("app-menu", ApplicationAppMenuPropertyInfo), '("application-id", GioA.ApplicationApplicationIdPropertyInfo), '("flags", GioA.ApplicationFlagsPropertyInfo), '("inactivity-timeout", GioA.ApplicationInactivityTimeoutPropertyInfo), '("is-busy", GioA.ApplicationIsBusyPropertyInfo), '("is-registered", GioA.ApplicationIsRegisteredPropertyInfo), '("is-remote", GioA.ApplicationIsRemotePropertyInfo), '("menubar", ApplicationMenubarPropertyInfo), '("register-session", ApplicationRegisterSessionPropertyInfo), '("resource-base-path", GioA.ApplicationResourceBasePathPropertyInfo)] -- VVV Prop "show-menubar" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getApplicationWindowShowMenubar :: (MonadIO m, ApplicationWindowK o) => o -> m Bool getApplicationWindowShowMenubar obj = liftIO $ getObjectPropertyBool obj "show-menubar" setApplicationWindowShowMenubar :: (MonadIO m, ApplicationWindowK o) => o -> Bool -> m () setApplicationWindowShowMenubar obj val = liftIO $ setObjectPropertyBool obj "show-menubar" val constructApplicationWindowShowMenubar :: Bool -> IO ([Char], GValue) constructApplicationWindowShowMenubar val = constructObjectPropertyBool "show-menubar" val data ApplicationWindowShowMenubarPropertyInfo instance AttrInfo ApplicationWindowShowMenubarPropertyInfo where type AttrAllowedOps ApplicationWindowShowMenubarPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ApplicationWindowShowMenubarPropertyInfo = (~) Bool type AttrBaseTypeConstraint ApplicationWindowShowMenubarPropertyInfo = ApplicationWindowK type AttrGetType ApplicationWindowShowMenubarPropertyInfo = Bool type AttrLabel ApplicationWindowShowMenubarPropertyInfo = "ApplicationWindow::show-menubar" attrGet _ = getApplicationWindowShowMenubar attrSet _ = setApplicationWindowShowMenubar attrConstruct _ = constructApplicationWindowShowMenubar type instance AttributeList ApplicationWindow = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-menubar", ApplicationWindowShowMenubarPropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] -- VVV Prop "arrow-type" -- Type: TInterface "Gtk" "ArrowType" -- Flags: [PropertyReadable,PropertyWritable] getArrowArrowType :: (MonadIO m, ArrowK o) => o -> m ArrowType getArrowArrowType obj = liftIO $ getObjectPropertyEnum obj "arrow-type" setArrowArrowType :: (MonadIO m, ArrowK o) => o -> ArrowType -> m () setArrowArrowType obj val = liftIO $ setObjectPropertyEnum obj "arrow-type" val constructArrowArrowType :: ArrowType -> IO ([Char], GValue) constructArrowArrowType val = constructObjectPropertyEnum "arrow-type" val data ArrowArrowTypePropertyInfo instance AttrInfo ArrowArrowTypePropertyInfo where type AttrAllowedOps ArrowArrowTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ArrowArrowTypePropertyInfo = (~) ArrowType type AttrBaseTypeConstraint ArrowArrowTypePropertyInfo = ArrowK type AttrGetType ArrowArrowTypePropertyInfo = ArrowType type AttrLabel ArrowArrowTypePropertyInfo = "Arrow::arrow-type" attrGet _ = getArrowArrowType attrSet _ = setArrowArrowType attrConstruct _ = constructArrowArrowType -- VVV Prop "shadow-type" -- Type: TInterface "Gtk" "ShadowType" -- Flags: [PropertyReadable,PropertyWritable] getArrowShadowType :: (MonadIO m, ArrowK o) => o -> m ShadowType getArrowShadowType obj = liftIO $ getObjectPropertyEnum obj "shadow-type" setArrowShadowType :: (MonadIO m, ArrowK o) => o -> ShadowType -> m () setArrowShadowType obj val = liftIO $ setObjectPropertyEnum obj "shadow-type" val constructArrowShadowType :: ShadowType -> IO ([Char], GValue) constructArrowShadowType val = constructObjectPropertyEnum "shadow-type" val data ArrowShadowTypePropertyInfo instance AttrInfo ArrowShadowTypePropertyInfo where type AttrAllowedOps ArrowShadowTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ArrowShadowTypePropertyInfo = (~) ShadowType type AttrBaseTypeConstraint ArrowShadowTypePropertyInfo = ArrowK type AttrGetType ArrowShadowTypePropertyInfo = ShadowType type AttrLabel ArrowShadowTypePropertyInfo = "Arrow::shadow-type" attrGet _ = getArrowShadowType attrSet _ = setArrowShadowType attrConstruct _ = constructArrowShadowType type instance AttributeList Arrow = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("arrow-type", ArrowArrowTypePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", ArrowShadowTypePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", MiscXalignPropertyInfo), '("xpad", MiscXpadPropertyInfo), '("yalign", MiscYalignPropertyInfo), '("ypad", MiscYpadPropertyInfo)] type instance AttributeList ArrowAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "obey-child" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getAspectFrameObeyChild :: (MonadIO m, AspectFrameK o) => o -> m Bool getAspectFrameObeyChild obj = liftIO $ getObjectPropertyBool obj "obey-child" setAspectFrameObeyChild :: (MonadIO m, AspectFrameK o) => o -> Bool -> m () setAspectFrameObeyChild obj val = liftIO $ setObjectPropertyBool obj "obey-child" val constructAspectFrameObeyChild :: Bool -> IO ([Char], GValue) constructAspectFrameObeyChild val = constructObjectPropertyBool "obey-child" val data AspectFrameObeyChildPropertyInfo instance AttrInfo AspectFrameObeyChildPropertyInfo where type AttrAllowedOps AspectFrameObeyChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AspectFrameObeyChildPropertyInfo = (~) Bool type AttrBaseTypeConstraint AspectFrameObeyChildPropertyInfo = AspectFrameK type AttrGetType AspectFrameObeyChildPropertyInfo = Bool type AttrLabel AspectFrameObeyChildPropertyInfo = "AspectFrame::obey-child" attrGet _ = getAspectFrameObeyChild attrSet _ = setAspectFrameObeyChild attrConstruct _ = constructAspectFrameObeyChild -- VVV Prop "ratio" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getAspectFrameRatio :: (MonadIO m, AspectFrameK o) => o -> m Float getAspectFrameRatio obj = liftIO $ getObjectPropertyFloat obj "ratio" setAspectFrameRatio :: (MonadIO m, AspectFrameK o) => o -> Float -> m () setAspectFrameRatio obj val = liftIO $ setObjectPropertyFloat obj "ratio" val constructAspectFrameRatio :: Float -> IO ([Char], GValue) constructAspectFrameRatio val = constructObjectPropertyFloat "ratio" val data AspectFrameRatioPropertyInfo instance AttrInfo AspectFrameRatioPropertyInfo where type AttrAllowedOps AspectFrameRatioPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AspectFrameRatioPropertyInfo = (~) Float type AttrBaseTypeConstraint AspectFrameRatioPropertyInfo = AspectFrameK type AttrGetType AspectFrameRatioPropertyInfo = Float type AttrLabel AspectFrameRatioPropertyInfo = "AspectFrame::ratio" attrGet _ = getAspectFrameRatio attrSet _ = setAspectFrameRatio attrConstruct _ = constructAspectFrameRatio -- VVV Prop "xalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getAspectFrameXalign :: (MonadIO m, AspectFrameK o) => o -> m Float getAspectFrameXalign obj = liftIO $ getObjectPropertyFloat obj "xalign" setAspectFrameXalign :: (MonadIO m, AspectFrameK o) => o -> Float -> m () setAspectFrameXalign obj val = liftIO $ setObjectPropertyFloat obj "xalign" val constructAspectFrameXalign :: Float -> IO ([Char], GValue) constructAspectFrameXalign val = constructObjectPropertyFloat "xalign" val data AspectFrameXalignPropertyInfo instance AttrInfo AspectFrameXalignPropertyInfo where type AttrAllowedOps AspectFrameXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AspectFrameXalignPropertyInfo = (~) Float type AttrBaseTypeConstraint AspectFrameXalignPropertyInfo = AspectFrameK type AttrGetType AspectFrameXalignPropertyInfo = Float type AttrLabel AspectFrameXalignPropertyInfo = "AspectFrame::xalign" attrGet _ = getAspectFrameXalign attrSet _ = setAspectFrameXalign attrConstruct _ = constructAspectFrameXalign -- VVV Prop "yalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getAspectFrameYalign :: (MonadIO m, AspectFrameK o) => o -> m Float getAspectFrameYalign obj = liftIO $ getObjectPropertyFloat obj "yalign" setAspectFrameYalign :: (MonadIO m, AspectFrameK o) => o -> Float -> m () setAspectFrameYalign obj val = liftIO $ setObjectPropertyFloat obj "yalign" val constructAspectFrameYalign :: Float -> IO ([Char], GValue) constructAspectFrameYalign val = constructObjectPropertyFloat "yalign" val data AspectFrameYalignPropertyInfo instance AttrInfo AspectFrameYalignPropertyInfo where type AttrAllowedOps AspectFrameYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AspectFrameYalignPropertyInfo = (~) Float type AttrBaseTypeConstraint AspectFrameYalignPropertyInfo = AspectFrameK type AttrGetType AspectFrameYalignPropertyInfo = Float type AttrLabel AspectFrameYalignPropertyInfo = "AspectFrame::yalign" attrGet _ = getAspectFrameYalign attrSet _ = setAspectFrameYalign attrConstruct _ = constructAspectFrameYalign type instance AttributeList AspectFrame = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", FrameLabelPropertyInfo), '("label-widget", FrameLabelWidgetPropertyInfo), '("label-xalign", FrameLabelXalignPropertyInfo), '("label-yalign", FrameLabelYalignPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("obey-child", AspectFrameObeyChildPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("ratio", AspectFrameRatioPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", FrameShadowTypePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", AspectFrameXalignPropertyInfo), '("yalign", AspectFrameYalignPropertyInfo)] -- VVV Prop "use-header-bar" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getAssistantUseHeaderBar :: (MonadIO m, AssistantK o) => o -> m Int32 getAssistantUseHeaderBar obj = liftIO $ getObjectPropertyCInt obj "use-header-bar" constructAssistantUseHeaderBar :: Int32 -> IO ([Char], GValue) constructAssistantUseHeaderBar val = constructObjectPropertyCInt "use-header-bar" val data AssistantUseHeaderBarPropertyInfo instance AttrInfo AssistantUseHeaderBarPropertyInfo where type AttrAllowedOps AssistantUseHeaderBarPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AssistantUseHeaderBarPropertyInfo = (~) Int32 type AttrBaseTypeConstraint AssistantUseHeaderBarPropertyInfo = AssistantK type AttrGetType AssistantUseHeaderBarPropertyInfo = Int32 type AttrLabel AssistantUseHeaderBarPropertyInfo = "Assistant::use-header-bar" attrGet _ = getAssistantUseHeaderBar attrSet _ = undefined attrConstruct _ = constructAssistantUseHeaderBar type instance AttributeList Assistant = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-header-bar", AssistantUseHeaderBarPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] type instance AttributeList Bin = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList BooleanCellAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("renderer", RendererCellAccessibleRendererPropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "baseline-position" -- Type: TInterface "Gtk" "BaselinePosition" -- Flags: [PropertyReadable,PropertyWritable] getBoxBaselinePosition :: (MonadIO m, BoxK o) => o -> m BaselinePosition getBoxBaselinePosition obj = liftIO $ getObjectPropertyEnum obj "baseline-position" setBoxBaselinePosition :: (MonadIO m, BoxK o) => o -> BaselinePosition -> m () setBoxBaselinePosition obj val = liftIO $ setObjectPropertyEnum obj "baseline-position" val constructBoxBaselinePosition :: BaselinePosition -> IO ([Char], GValue) constructBoxBaselinePosition val = constructObjectPropertyEnum "baseline-position" val data BoxBaselinePositionPropertyInfo instance AttrInfo BoxBaselinePositionPropertyInfo where type AttrAllowedOps BoxBaselinePositionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint BoxBaselinePositionPropertyInfo = (~) BaselinePosition type AttrBaseTypeConstraint BoxBaselinePositionPropertyInfo = BoxK type AttrGetType BoxBaselinePositionPropertyInfo = BaselinePosition type AttrLabel BoxBaselinePositionPropertyInfo = "Box::baseline-position" attrGet _ = getBoxBaselinePosition attrSet _ = setBoxBaselinePosition attrConstruct _ = constructBoxBaselinePosition -- VVV Prop "homogeneous" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getBoxHomogeneous :: (MonadIO m, BoxK o) => o -> m Bool getBoxHomogeneous obj = liftIO $ getObjectPropertyBool obj "homogeneous" setBoxHomogeneous :: (MonadIO m, BoxK o) => o -> Bool -> m () setBoxHomogeneous obj val = liftIO $ setObjectPropertyBool obj "homogeneous" val constructBoxHomogeneous :: Bool -> IO ([Char], GValue) constructBoxHomogeneous val = constructObjectPropertyBool "homogeneous" val data BoxHomogeneousPropertyInfo instance AttrInfo BoxHomogeneousPropertyInfo where type AttrAllowedOps BoxHomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint BoxHomogeneousPropertyInfo = (~) Bool type AttrBaseTypeConstraint BoxHomogeneousPropertyInfo = BoxK type AttrGetType BoxHomogeneousPropertyInfo = Bool type AttrLabel BoxHomogeneousPropertyInfo = "Box::homogeneous" attrGet _ = getBoxHomogeneous attrSet _ = setBoxHomogeneous attrConstruct _ = constructBoxHomogeneous -- VVV Prop "spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getBoxSpacing :: (MonadIO m, BoxK o) => o -> m Int32 getBoxSpacing obj = liftIO $ getObjectPropertyCInt obj "spacing" setBoxSpacing :: (MonadIO m, BoxK o) => o -> Int32 -> m () setBoxSpacing obj val = liftIO $ setObjectPropertyCInt obj "spacing" val constructBoxSpacing :: Int32 -> IO ([Char], GValue) constructBoxSpacing val = constructObjectPropertyCInt "spacing" val data BoxSpacingPropertyInfo instance AttrInfo BoxSpacingPropertyInfo where type AttrAllowedOps BoxSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint BoxSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint BoxSpacingPropertyInfo = BoxK type AttrGetType BoxSpacingPropertyInfo = Int32 type AttrLabel BoxSpacingPropertyInfo = "Box::spacing" attrGet _ = getBoxSpacing attrSet _ = setBoxSpacing attrConstruct _ = constructBoxSpacing type instance AttributeList Box = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList Buildable = '[ ] -- VVV Prop "translation-domain" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getBuilderTranslationDomain :: (MonadIO m, BuilderK o) => o -> m T.Text getBuilderTranslationDomain obj = liftIO $ getObjectPropertyString obj "translation-domain" setBuilderTranslationDomain :: (MonadIO m, BuilderK o) => o -> T.Text -> m () setBuilderTranslationDomain obj val = liftIO $ setObjectPropertyString obj "translation-domain" val constructBuilderTranslationDomain :: T.Text -> IO ([Char], GValue) constructBuilderTranslationDomain val = constructObjectPropertyString "translation-domain" val data BuilderTranslationDomainPropertyInfo instance AttrInfo BuilderTranslationDomainPropertyInfo where type AttrAllowedOps BuilderTranslationDomainPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint BuilderTranslationDomainPropertyInfo = (~) T.Text type AttrBaseTypeConstraint BuilderTranslationDomainPropertyInfo = BuilderK type AttrGetType BuilderTranslationDomainPropertyInfo = T.Text type AttrLabel BuilderTranslationDomainPropertyInfo = "Builder::translation-domain" attrGet _ = getBuilderTranslationDomain attrSet _ = setBuilderTranslationDomain attrConstruct _ = constructBuilderTranslationDomain type instance AttributeList Builder = '[ '("translation-domain", BuilderTranslationDomainPropertyInfo)] -- VVV Prop "always-show-image" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getButtonAlwaysShowImage :: (MonadIO m, ButtonK o) => o -> m Bool getButtonAlwaysShowImage obj = liftIO $ getObjectPropertyBool obj "always-show-image" setButtonAlwaysShowImage :: (MonadIO m, ButtonK o) => o -> Bool -> m () setButtonAlwaysShowImage obj val = liftIO $ setObjectPropertyBool obj "always-show-image" val constructButtonAlwaysShowImage :: Bool -> IO ([Char], GValue) constructButtonAlwaysShowImage val = constructObjectPropertyBool "always-show-image" val data ButtonAlwaysShowImagePropertyInfo instance AttrInfo ButtonAlwaysShowImagePropertyInfo where type AttrAllowedOps ButtonAlwaysShowImagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonAlwaysShowImagePropertyInfo = (~) Bool type AttrBaseTypeConstraint ButtonAlwaysShowImagePropertyInfo = ButtonK type AttrGetType ButtonAlwaysShowImagePropertyInfo = Bool type AttrLabel ButtonAlwaysShowImagePropertyInfo = "Button::always-show-image" attrGet _ = getButtonAlwaysShowImage attrSet _ = setButtonAlwaysShowImage attrConstruct _ = constructButtonAlwaysShowImage -- VVV Prop "focus-on-click" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getButtonFocusOnClick :: (MonadIO m, ButtonK o) => o -> m Bool getButtonFocusOnClick obj = liftIO $ getObjectPropertyBool obj "focus-on-click" setButtonFocusOnClick :: (MonadIO m, ButtonK o) => o -> Bool -> m () setButtonFocusOnClick obj val = liftIO $ setObjectPropertyBool obj "focus-on-click" val constructButtonFocusOnClick :: Bool -> IO ([Char], GValue) constructButtonFocusOnClick val = constructObjectPropertyBool "focus-on-click" val data ButtonFocusOnClickPropertyInfo instance AttrInfo ButtonFocusOnClickPropertyInfo where type AttrAllowedOps ButtonFocusOnClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonFocusOnClickPropertyInfo = (~) Bool type AttrBaseTypeConstraint ButtonFocusOnClickPropertyInfo = ButtonK type AttrGetType ButtonFocusOnClickPropertyInfo = Bool type AttrLabel ButtonFocusOnClickPropertyInfo = "Button::focus-on-click" attrGet _ = getButtonFocusOnClick attrSet _ = setButtonFocusOnClick attrConstruct _ = constructButtonFocusOnClick -- VVV Prop "image" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getButtonImage :: (MonadIO m, ButtonK o) => o -> m Widget getButtonImage obj = liftIO $ getObjectPropertyObject obj "image" Widget setButtonImage :: (MonadIO m, ButtonK o, WidgetK a) => o -> a -> m () setButtonImage obj val = liftIO $ setObjectPropertyObject obj "image" val constructButtonImage :: (WidgetK a) => a -> IO ([Char], GValue) constructButtonImage val = constructObjectPropertyObject "image" val data ButtonImagePropertyInfo instance AttrInfo ButtonImagePropertyInfo where type AttrAllowedOps ButtonImagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonImagePropertyInfo = WidgetK type AttrBaseTypeConstraint ButtonImagePropertyInfo = ButtonK type AttrGetType ButtonImagePropertyInfo = Widget type AttrLabel ButtonImagePropertyInfo = "Button::image" attrGet _ = getButtonImage attrSet _ = setButtonImage attrConstruct _ = constructButtonImage -- VVV Prop "image-position" -- Type: TInterface "Gtk" "PositionType" -- Flags: [PropertyReadable,PropertyWritable] getButtonImagePosition :: (MonadIO m, ButtonK o) => o -> m PositionType getButtonImagePosition obj = liftIO $ getObjectPropertyEnum obj "image-position" setButtonImagePosition :: (MonadIO m, ButtonK o) => o -> PositionType -> m () setButtonImagePosition obj val = liftIO $ setObjectPropertyEnum obj "image-position" val constructButtonImagePosition :: PositionType -> IO ([Char], GValue) constructButtonImagePosition val = constructObjectPropertyEnum "image-position" val data ButtonImagePositionPropertyInfo instance AttrInfo ButtonImagePositionPropertyInfo where type AttrAllowedOps ButtonImagePositionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonImagePositionPropertyInfo = (~) PositionType type AttrBaseTypeConstraint ButtonImagePositionPropertyInfo = ButtonK type AttrGetType ButtonImagePositionPropertyInfo = PositionType type AttrLabel ButtonImagePositionPropertyInfo = "Button::image-position" attrGet _ = getButtonImagePosition attrSet _ = setButtonImagePosition attrConstruct _ = constructButtonImagePosition -- VVV Prop "label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getButtonLabel :: (MonadIO m, ButtonK o) => o -> m T.Text getButtonLabel obj = liftIO $ getObjectPropertyString obj "label" setButtonLabel :: (MonadIO m, ButtonK o) => o -> T.Text -> m () setButtonLabel obj val = liftIO $ setObjectPropertyString obj "label" val constructButtonLabel :: T.Text -> IO ([Char], GValue) constructButtonLabel val = constructObjectPropertyString "label" val data ButtonLabelPropertyInfo instance AttrInfo ButtonLabelPropertyInfo where type AttrAllowedOps ButtonLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ButtonLabelPropertyInfo = ButtonK type AttrGetType ButtonLabelPropertyInfo = T.Text type AttrLabel ButtonLabelPropertyInfo = "Button::label" attrGet _ = getButtonLabel attrSet _ = setButtonLabel attrConstruct _ = constructButtonLabel -- VVV Prop "relief" -- Type: TInterface "Gtk" "ReliefStyle" -- Flags: [PropertyReadable,PropertyWritable] getButtonRelief :: (MonadIO m, ButtonK o) => o -> m ReliefStyle getButtonRelief obj = liftIO $ getObjectPropertyEnum obj "relief" setButtonRelief :: (MonadIO m, ButtonK o) => o -> ReliefStyle -> m () setButtonRelief obj val = liftIO $ setObjectPropertyEnum obj "relief" val constructButtonRelief :: ReliefStyle -> IO ([Char], GValue) constructButtonRelief val = constructObjectPropertyEnum "relief" val data ButtonReliefPropertyInfo instance AttrInfo ButtonReliefPropertyInfo where type AttrAllowedOps ButtonReliefPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonReliefPropertyInfo = (~) ReliefStyle type AttrBaseTypeConstraint ButtonReliefPropertyInfo = ButtonK type AttrGetType ButtonReliefPropertyInfo = ReliefStyle type AttrLabel ButtonReliefPropertyInfo = "Button::relief" attrGet _ = getButtonRelief attrSet _ = setButtonRelief attrConstruct _ = constructButtonRelief -- VVV Prop "use-stock" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getButtonUseStock :: (MonadIO m, ButtonK o) => o -> m Bool getButtonUseStock obj = liftIO $ getObjectPropertyBool obj "use-stock" setButtonUseStock :: (MonadIO m, ButtonK o) => o -> Bool -> m () setButtonUseStock obj val = liftIO $ setObjectPropertyBool obj "use-stock" val constructButtonUseStock :: Bool -> IO ([Char], GValue) constructButtonUseStock val = constructObjectPropertyBool "use-stock" val data ButtonUseStockPropertyInfo instance AttrInfo ButtonUseStockPropertyInfo where type AttrAllowedOps ButtonUseStockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonUseStockPropertyInfo = (~) Bool type AttrBaseTypeConstraint ButtonUseStockPropertyInfo = ButtonK type AttrGetType ButtonUseStockPropertyInfo = Bool type AttrLabel ButtonUseStockPropertyInfo = "Button::use-stock" attrGet _ = getButtonUseStock attrSet _ = setButtonUseStock attrConstruct _ = constructButtonUseStock -- VVV Prop "use-underline" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getButtonUseUnderline :: (MonadIO m, ButtonK o) => o -> m Bool getButtonUseUnderline obj = liftIO $ getObjectPropertyBool obj "use-underline" setButtonUseUnderline :: (MonadIO m, ButtonK o) => o -> Bool -> m () setButtonUseUnderline obj val = liftIO $ setObjectPropertyBool obj "use-underline" val constructButtonUseUnderline :: Bool -> IO ([Char], GValue) constructButtonUseUnderline val = constructObjectPropertyBool "use-underline" val data ButtonUseUnderlinePropertyInfo instance AttrInfo ButtonUseUnderlinePropertyInfo where type AttrAllowedOps ButtonUseUnderlinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonUseUnderlinePropertyInfo = (~) Bool type AttrBaseTypeConstraint ButtonUseUnderlinePropertyInfo = ButtonK type AttrGetType ButtonUseUnderlinePropertyInfo = Bool type AttrLabel ButtonUseUnderlinePropertyInfo = "Button::use-underline" attrGet _ = getButtonUseUnderline attrSet _ = setButtonUseUnderline attrConstruct _ = constructButtonUseUnderline -- VVV Prop "xalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getButtonXalign :: (MonadIO m, ButtonK o) => o -> m Float getButtonXalign obj = liftIO $ getObjectPropertyFloat obj "xalign" setButtonXalign :: (MonadIO m, ButtonK o) => o -> Float -> m () setButtonXalign obj val = liftIO $ setObjectPropertyFloat obj "xalign" val constructButtonXalign :: Float -> IO ([Char], GValue) constructButtonXalign val = constructObjectPropertyFloat "xalign" val data ButtonXalignPropertyInfo instance AttrInfo ButtonXalignPropertyInfo where type AttrAllowedOps ButtonXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonXalignPropertyInfo = (~) Float type AttrBaseTypeConstraint ButtonXalignPropertyInfo = ButtonK type AttrGetType ButtonXalignPropertyInfo = Float type AttrLabel ButtonXalignPropertyInfo = "Button::xalign" attrGet _ = getButtonXalign attrSet _ = setButtonXalign attrConstruct _ = constructButtonXalign -- VVV Prop "yalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getButtonYalign :: (MonadIO m, ButtonK o) => o -> m Float getButtonYalign obj = liftIO $ getObjectPropertyFloat obj "yalign" setButtonYalign :: (MonadIO m, ButtonK o) => o -> Float -> m () setButtonYalign obj val = liftIO $ setObjectPropertyFloat obj "yalign" val constructButtonYalign :: Float -> IO ([Char], GValue) constructButtonYalign val = constructObjectPropertyFloat "yalign" val data ButtonYalignPropertyInfo instance AttrInfo ButtonYalignPropertyInfo where type AttrAllowedOps ButtonYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonYalignPropertyInfo = (~) Float type AttrBaseTypeConstraint ButtonYalignPropertyInfo = ButtonK type AttrGetType ButtonYalignPropertyInfo = Float type AttrLabel ButtonYalignPropertyInfo = "Button::yalign" attrGet _ = getButtonYalign attrSet _ = setButtonYalign attrConstruct _ = constructButtonYalign type instance AttributeList Button = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] type instance AttributeList ButtonAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "layout-style" -- Type: TInterface "Gtk" "ButtonBoxStyle" -- Flags: [PropertyReadable,PropertyWritable] getButtonBoxLayoutStyle :: (MonadIO m, ButtonBoxK o) => o -> m ButtonBoxStyle getButtonBoxLayoutStyle obj = liftIO $ getObjectPropertyEnum obj "layout-style" setButtonBoxLayoutStyle :: (MonadIO m, ButtonBoxK o) => o -> ButtonBoxStyle -> m () setButtonBoxLayoutStyle obj val = liftIO $ setObjectPropertyEnum obj "layout-style" val constructButtonBoxLayoutStyle :: ButtonBoxStyle -> IO ([Char], GValue) constructButtonBoxLayoutStyle val = constructObjectPropertyEnum "layout-style" val data ButtonBoxLayoutStylePropertyInfo instance AttrInfo ButtonBoxLayoutStylePropertyInfo where type AttrAllowedOps ButtonBoxLayoutStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ButtonBoxLayoutStylePropertyInfo = (~) ButtonBoxStyle type AttrBaseTypeConstraint ButtonBoxLayoutStylePropertyInfo = ButtonBoxK type AttrGetType ButtonBoxLayoutStylePropertyInfo = ButtonBoxStyle type AttrLabel ButtonBoxLayoutStylePropertyInfo = "ButtonBox::layout-style" attrGet _ = getButtonBoxLayoutStyle attrSet _ = setButtonBoxLayoutStyle attrConstruct _ = constructButtonBoxLayoutStyle type instance AttributeList ButtonBox = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("layout-style", ButtonBoxLayoutStylePropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "day" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCalendarDay :: (MonadIO m, CalendarK o) => o -> m Int32 getCalendarDay obj = liftIO $ getObjectPropertyCInt obj "day" setCalendarDay :: (MonadIO m, CalendarK o) => o -> Int32 -> m () setCalendarDay obj val = liftIO $ setObjectPropertyCInt obj "day" val constructCalendarDay :: Int32 -> IO ([Char], GValue) constructCalendarDay val = constructObjectPropertyCInt "day" val data CalendarDayPropertyInfo instance AttrInfo CalendarDayPropertyInfo where type AttrAllowedOps CalendarDayPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CalendarDayPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CalendarDayPropertyInfo = CalendarK type AttrGetType CalendarDayPropertyInfo = Int32 type AttrLabel CalendarDayPropertyInfo = "Calendar::day" attrGet _ = getCalendarDay attrSet _ = setCalendarDay attrConstruct _ = constructCalendarDay -- VVV Prop "detail-height-rows" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCalendarDetailHeightRows :: (MonadIO m, CalendarK o) => o -> m Int32 getCalendarDetailHeightRows obj = liftIO $ getObjectPropertyCInt obj "detail-height-rows" setCalendarDetailHeightRows :: (MonadIO m, CalendarK o) => o -> Int32 -> m () setCalendarDetailHeightRows obj val = liftIO $ setObjectPropertyCInt obj "detail-height-rows" val constructCalendarDetailHeightRows :: Int32 -> IO ([Char], GValue) constructCalendarDetailHeightRows val = constructObjectPropertyCInt "detail-height-rows" val data CalendarDetailHeightRowsPropertyInfo instance AttrInfo CalendarDetailHeightRowsPropertyInfo where type AttrAllowedOps CalendarDetailHeightRowsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CalendarDetailHeightRowsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CalendarDetailHeightRowsPropertyInfo = CalendarK type AttrGetType CalendarDetailHeightRowsPropertyInfo = Int32 type AttrLabel CalendarDetailHeightRowsPropertyInfo = "Calendar::detail-height-rows" attrGet _ = getCalendarDetailHeightRows attrSet _ = setCalendarDetailHeightRows attrConstruct _ = constructCalendarDetailHeightRows -- VVV Prop "detail-width-chars" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCalendarDetailWidthChars :: (MonadIO m, CalendarK o) => o -> m Int32 getCalendarDetailWidthChars obj = liftIO $ getObjectPropertyCInt obj "detail-width-chars" setCalendarDetailWidthChars :: (MonadIO m, CalendarK o) => o -> Int32 -> m () setCalendarDetailWidthChars obj val = liftIO $ setObjectPropertyCInt obj "detail-width-chars" val constructCalendarDetailWidthChars :: Int32 -> IO ([Char], GValue) constructCalendarDetailWidthChars val = constructObjectPropertyCInt "detail-width-chars" val data CalendarDetailWidthCharsPropertyInfo instance AttrInfo CalendarDetailWidthCharsPropertyInfo where type AttrAllowedOps CalendarDetailWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CalendarDetailWidthCharsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CalendarDetailWidthCharsPropertyInfo = CalendarK type AttrGetType CalendarDetailWidthCharsPropertyInfo = Int32 type AttrLabel CalendarDetailWidthCharsPropertyInfo = "Calendar::detail-width-chars" attrGet _ = getCalendarDetailWidthChars attrSet _ = setCalendarDetailWidthChars attrConstruct _ = constructCalendarDetailWidthChars -- VVV Prop "month" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCalendarMonth :: (MonadIO m, CalendarK o) => o -> m Int32 getCalendarMonth obj = liftIO $ getObjectPropertyCInt obj "month" setCalendarMonth :: (MonadIO m, CalendarK o) => o -> Int32 -> m () setCalendarMonth obj val = liftIO $ setObjectPropertyCInt obj "month" val constructCalendarMonth :: Int32 -> IO ([Char], GValue) constructCalendarMonth val = constructObjectPropertyCInt "month" val data CalendarMonthPropertyInfo instance AttrInfo CalendarMonthPropertyInfo where type AttrAllowedOps CalendarMonthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CalendarMonthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CalendarMonthPropertyInfo = CalendarK type AttrGetType CalendarMonthPropertyInfo = Int32 type AttrLabel CalendarMonthPropertyInfo = "Calendar::month" attrGet _ = getCalendarMonth attrSet _ = setCalendarMonth attrConstruct _ = constructCalendarMonth -- VVV Prop "no-month-change" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCalendarNoMonthChange :: (MonadIO m, CalendarK o) => o -> m Bool getCalendarNoMonthChange obj = liftIO $ getObjectPropertyBool obj "no-month-change" setCalendarNoMonthChange :: (MonadIO m, CalendarK o) => o -> Bool -> m () setCalendarNoMonthChange obj val = liftIO $ setObjectPropertyBool obj "no-month-change" val constructCalendarNoMonthChange :: Bool -> IO ([Char], GValue) constructCalendarNoMonthChange val = constructObjectPropertyBool "no-month-change" val data CalendarNoMonthChangePropertyInfo instance AttrInfo CalendarNoMonthChangePropertyInfo where type AttrAllowedOps CalendarNoMonthChangePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CalendarNoMonthChangePropertyInfo = (~) Bool type AttrBaseTypeConstraint CalendarNoMonthChangePropertyInfo = CalendarK type AttrGetType CalendarNoMonthChangePropertyInfo = Bool type AttrLabel CalendarNoMonthChangePropertyInfo = "Calendar::no-month-change" attrGet _ = getCalendarNoMonthChange attrSet _ = setCalendarNoMonthChange attrConstruct _ = constructCalendarNoMonthChange -- VVV Prop "show-day-names" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCalendarShowDayNames :: (MonadIO m, CalendarK o) => o -> m Bool getCalendarShowDayNames obj = liftIO $ getObjectPropertyBool obj "show-day-names" setCalendarShowDayNames :: (MonadIO m, CalendarK o) => o -> Bool -> m () setCalendarShowDayNames obj val = liftIO $ setObjectPropertyBool obj "show-day-names" val constructCalendarShowDayNames :: Bool -> IO ([Char], GValue) constructCalendarShowDayNames val = constructObjectPropertyBool "show-day-names" val data CalendarShowDayNamesPropertyInfo instance AttrInfo CalendarShowDayNamesPropertyInfo where type AttrAllowedOps CalendarShowDayNamesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CalendarShowDayNamesPropertyInfo = (~) Bool type AttrBaseTypeConstraint CalendarShowDayNamesPropertyInfo = CalendarK type AttrGetType CalendarShowDayNamesPropertyInfo = Bool type AttrLabel CalendarShowDayNamesPropertyInfo = "Calendar::show-day-names" attrGet _ = getCalendarShowDayNames attrSet _ = setCalendarShowDayNames attrConstruct _ = constructCalendarShowDayNames -- VVV Prop "show-details" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCalendarShowDetails :: (MonadIO m, CalendarK o) => o -> m Bool getCalendarShowDetails obj = liftIO $ getObjectPropertyBool obj "show-details" setCalendarShowDetails :: (MonadIO m, CalendarK o) => o -> Bool -> m () setCalendarShowDetails obj val = liftIO $ setObjectPropertyBool obj "show-details" val constructCalendarShowDetails :: Bool -> IO ([Char], GValue) constructCalendarShowDetails val = constructObjectPropertyBool "show-details" val data CalendarShowDetailsPropertyInfo instance AttrInfo CalendarShowDetailsPropertyInfo where type AttrAllowedOps CalendarShowDetailsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CalendarShowDetailsPropertyInfo = (~) Bool type AttrBaseTypeConstraint CalendarShowDetailsPropertyInfo = CalendarK type AttrGetType CalendarShowDetailsPropertyInfo = Bool type AttrLabel CalendarShowDetailsPropertyInfo = "Calendar::show-details" attrGet _ = getCalendarShowDetails attrSet _ = setCalendarShowDetails attrConstruct _ = constructCalendarShowDetails -- VVV Prop "show-heading" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCalendarShowHeading :: (MonadIO m, CalendarK o) => o -> m Bool getCalendarShowHeading obj = liftIO $ getObjectPropertyBool obj "show-heading" setCalendarShowHeading :: (MonadIO m, CalendarK o) => o -> Bool -> m () setCalendarShowHeading obj val = liftIO $ setObjectPropertyBool obj "show-heading" val constructCalendarShowHeading :: Bool -> IO ([Char], GValue) constructCalendarShowHeading val = constructObjectPropertyBool "show-heading" val data CalendarShowHeadingPropertyInfo instance AttrInfo CalendarShowHeadingPropertyInfo where type AttrAllowedOps CalendarShowHeadingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CalendarShowHeadingPropertyInfo = (~) Bool type AttrBaseTypeConstraint CalendarShowHeadingPropertyInfo = CalendarK type AttrGetType CalendarShowHeadingPropertyInfo = Bool type AttrLabel CalendarShowHeadingPropertyInfo = "Calendar::show-heading" attrGet _ = getCalendarShowHeading attrSet _ = setCalendarShowHeading attrConstruct _ = constructCalendarShowHeading -- VVV Prop "show-week-numbers" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCalendarShowWeekNumbers :: (MonadIO m, CalendarK o) => o -> m Bool getCalendarShowWeekNumbers obj = liftIO $ getObjectPropertyBool obj "show-week-numbers" setCalendarShowWeekNumbers :: (MonadIO m, CalendarK o) => o -> Bool -> m () setCalendarShowWeekNumbers obj val = liftIO $ setObjectPropertyBool obj "show-week-numbers" val constructCalendarShowWeekNumbers :: Bool -> IO ([Char], GValue) constructCalendarShowWeekNumbers val = constructObjectPropertyBool "show-week-numbers" val data CalendarShowWeekNumbersPropertyInfo instance AttrInfo CalendarShowWeekNumbersPropertyInfo where type AttrAllowedOps CalendarShowWeekNumbersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CalendarShowWeekNumbersPropertyInfo = (~) Bool type AttrBaseTypeConstraint CalendarShowWeekNumbersPropertyInfo = CalendarK type AttrGetType CalendarShowWeekNumbersPropertyInfo = Bool type AttrLabel CalendarShowWeekNumbersPropertyInfo = "Calendar::show-week-numbers" attrGet _ = getCalendarShowWeekNumbers attrSet _ = setCalendarShowWeekNumbers attrConstruct _ = constructCalendarShowWeekNumbers -- VVV Prop "year" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCalendarYear :: (MonadIO m, CalendarK o) => o -> m Int32 getCalendarYear obj = liftIO $ getObjectPropertyCInt obj "year" setCalendarYear :: (MonadIO m, CalendarK o) => o -> Int32 -> m () setCalendarYear obj val = liftIO $ setObjectPropertyCInt obj "year" val constructCalendarYear :: Int32 -> IO ([Char], GValue) constructCalendarYear val = constructObjectPropertyCInt "year" val data CalendarYearPropertyInfo instance AttrInfo CalendarYearPropertyInfo where type AttrAllowedOps CalendarYearPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CalendarYearPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CalendarYearPropertyInfo = CalendarK type AttrGetType CalendarYearPropertyInfo = Int32 type AttrLabel CalendarYearPropertyInfo = "Calendar::year" attrGet _ = getCalendarYear attrSet _ = setCalendarYear attrConstruct _ = constructCalendarYear type instance AttributeList Calendar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("day", CalendarDayPropertyInfo), '("detail-height-rows", CalendarDetailHeightRowsPropertyInfo), '("detail-width-chars", CalendarDetailWidthCharsPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("month", CalendarMonthPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-month-change", CalendarNoMonthChangePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-day-names", CalendarShowDayNamesPropertyInfo), '("show-details", CalendarShowDetailsPropertyInfo), '("show-heading", CalendarShowHeadingPropertyInfo), '("show-week-numbers", CalendarShowWeekNumbersPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("year", CalendarYearPropertyInfo)] type instance AttributeList CellAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList CellAccessibleParent = '[ ] -- VVV Prop "edit-widget" -- Type: TInterface "Gtk" "CellEditable" -- Flags: [PropertyReadable] getCellAreaEditWidget :: (MonadIO m, CellAreaK o) => o -> m CellEditable getCellAreaEditWidget obj = liftIO $ getObjectPropertyObject obj "edit-widget" CellEditable data CellAreaEditWidgetPropertyInfo instance AttrInfo CellAreaEditWidgetPropertyInfo where type AttrAllowedOps CellAreaEditWidgetPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint CellAreaEditWidgetPropertyInfo = (~) () type AttrBaseTypeConstraint CellAreaEditWidgetPropertyInfo = CellAreaK type AttrGetType CellAreaEditWidgetPropertyInfo = CellEditable type AttrLabel CellAreaEditWidgetPropertyInfo = "CellArea::edit-widget" attrGet _ = getCellAreaEditWidget attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "edited-cell" -- Type: TInterface "Gtk" "CellRenderer" -- Flags: [PropertyReadable] getCellAreaEditedCell :: (MonadIO m, CellAreaK o) => o -> m CellRenderer getCellAreaEditedCell obj = liftIO $ getObjectPropertyObject obj "edited-cell" CellRenderer data CellAreaEditedCellPropertyInfo instance AttrInfo CellAreaEditedCellPropertyInfo where type AttrAllowedOps CellAreaEditedCellPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint CellAreaEditedCellPropertyInfo = (~) () type AttrBaseTypeConstraint CellAreaEditedCellPropertyInfo = CellAreaK type AttrGetType CellAreaEditedCellPropertyInfo = CellRenderer type AttrLabel CellAreaEditedCellPropertyInfo = "CellArea::edited-cell" attrGet _ = getCellAreaEditedCell attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "focus-cell" -- Type: TInterface "Gtk" "CellRenderer" -- Flags: [PropertyReadable,PropertyWritable] getCellAreaFocusCell :: (MonadIO m, CellAreaK o) => o -> m CellRenderer getCellAreaFocusCell obj = liftIO $ getObjectPropertyObject obj "focus-cell" CellRenderer setCellAreaFocusCell :: (MonadIO m, CellAreaK o, CellRendererK a) => o -> a -> m () setCellAreaFocusCell obj val = liftIO $ setObjectPropertyObject obj "focus-cell" val constructCellAreaFocusCell :: (CellRendererK a) => a -> IO ([Char], GValue) constructCellAreaFocusCell val = constructObjectPropertyObject "focus-cell" val data CellAreaFocusCellPropertyInfo instance AttrInfo CellAreaFocusCellPropertyInfo where type AttrAllowedOps CellAreaFocusCellPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellAreaFocusCellPropertyInfo = CellRendererK type AttrBaseTypeConstraint CellAreaFocusCellPropertyInfo = CellAreaK type AttrGetType CellAreaFocusCellPropertyInfo = CellRenderer type AttrLabel CellAreaFocusCellPropertyInfo = "CellArea::focus-cell" attrGet _ = getCellAreaFocusCell attrSet _ = setCellAreaFocusCell attrConstruct _ = constructCellAreaFocusCell type instance AttributeList CellArea = '[ '("edit-widget", CellAreaEditWidgetPropertyInfo), '("edited-cell", CellAreaEditedCellPropertyInfo), '("focus-cell", CellAreaFocusCellPropertyInfo)] -- VVV Prop "spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellAreaBoxSpacing :: (MonadIO m, CellAreaBoxK o) => o -> m Int32 getCellAreaBoxSpacing obj = liftIO $ getObjectPropertyCInt obj "spacing" setCellAreaBoxSpacing :: (MonadIO m, CellAreaBoxK o) => o -> Int32 -> m () setCellAreaBoxSpacing obj val = liftIO $ setObjectPropertyCInt obj "spacing" val constructCellAreaBoxSpacing :: Int32 -> IO ([Char], GValue) constructCellAreaBoxSpacing val = constructObjectPropertyCInt "spacing" val data CellAreaBoxSpacingPropertyInfo instance AttrInfo CellAreaBoxSpacingPropertyInfo where type AttrAllowedOps CellAreaBoxSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellAreaBoxSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellAreaBoxSpacingPropertyInfo = CellAreaBoxK type AttrGetType CellAreaBoxSpacingPropertyInfo = Int32 type AttrLabel CellAreaBoxSpacingPropertyInfo = "CellAreaBox::spacing" attrGet _ = getCellAreaBoxSpacing attrSet _ = setCellAreaBoxSpacing attrConstruct _ = constructCellAreaBoxSpacing type instance AttributeList CellAreaBox = '[ '("edit-widget", CellAreaEditWidgetPropertyInfo), '("edited-cell", CellAreaEditedCellPropertyInfo), '("focus-cell", CellAreaFocusCellPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("spacing", CellAreaBoxSpacingPropertyInfo)] -- VVV Prop "area" -- Type: TInterface "Gtk" "CellArea" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getCellAreaContextArea :: (MonadIO m, CellAreaContextK o) => o -> m CellArea getCellAreaContextArea obj = liftIO $ getObjectPropertyObject obj "area" CellArea constructCellAreaContextArea :: (CellAreaK a) => a -> IO ([Char], GValue) constructCellAreaContextArea val = constructObjectPropertyObject "area" val data CellAreaContextAreaPropertyInfo instance AttrInfo CellAreaContextAreaPropertyInfo where type AttrAllowedOps CellAreaContextAreaPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellAreaContextAreaPropertyInfo = CellAreaK type AttrBaseTypeConstraint CellAreaContextAreaPropertyInfo = CellAreaContextK type AttrGetType CellAreaContextAreaPropertyInfo = CellArea type AttrLabel CellAreaContextAreaPropertyInfo = "CellAreaContext::area" attrGet _ = getCellAreaContextArea attrSet _ = undefined attrConstruct _ = constructCellAreaContextArea -- VVV Prop "minimum-height" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getCellAreaContextMinimumHeight :: (MonadIO m, CellAreaContextK o) => o -> m Int32 getCellAreaContextMinimumHeight obj = liftIO $ getObjectPropertyCInt obj "minimum-height" data CellAreaContextMinimumHeightPropertyInfo instance AttrInfo CellAreaContextMinimumHeightPropertyInfo where type AttrAllowedOps CellAreaContextMinimumHeightPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint CellAreaContextMinimumHeightPropertyInfo = (~) () type AttrBaseTypeConstraint CellAreaContextMinimumHeightPropertyInfo = CellAreaContextK type AttrGetType CellAreaContextMinimumHeightPropertyInfo = Int32 type AttrLabel CellAreaContextMinimumHeightPropertyInfo = "CellAreaContext::minimum-height" attrGet _ = getCellAreaContextMinimumHeight attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "minimum-width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getCellAreaContextMinimumWidth :: (MonadIO m, CellAreaContextK o) => o -> m Int32 getCellAreaContextMinimumWidth obj = liftIO $ getObjectPropertyCInt obj "minimum-width" data CellAreaContextMinimumWidthPropertyInfo instance AttrInfo CellAreaContextMinimumWidthPropertyInfo where type AttrAllowedOps CellAreaContextMinimumWidthPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint CellAreaContextMinimumWidthPropertyInfo = (~) () type AttrBaseTypeConstraint CellAreaContextMinimumWidthPropertyInfo = CellAreaContextK type AttrGetType CellAreaContextMinimumWidthPropertyInfo = Int32 type AttrLabel CellAreaContextMinimumWidthPropertyInfo = "CellAreaContext::minimum-width" attrGet _ = getCellAreaContextMinimumWidth attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "natural-height" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getCellAreaContextNaturalHeight :: (MonadIO m, CellAreaContextK o) => o -> m Int32 getCellAreaContextNaturalHeight obj = liftIO $ getObjectPropertyCInt obj "natural-height" data CellAreaContextNaturalHeightPropertyInfo instance AttrInfo CellAreaContextNaturalHeightPropertyInfo where type AttrAllowedOps CellAreaContextNaturalHeightPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint CellAreaContextNaturalHeightPropertyInfo = (~) () type AttrBaseTypeConstraint CellAreaContextNaturalHeightPropertyInfo = CellAreaContextK type AttrGetType CellAreaContextNaturalHeightPropertyInfo = Int32 type AttrLabel CellAreaContextNaturalHeightPropertyInfo = "CellAreaContext::natural-height" attrGet _ = getCellAreaContextNaturalHeight attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "natural-width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getCellAreaContextNaturalWidth :: (MonadIO m, CellAreaContextK o) => o -> m Int32 getCellAreaContextNaturalWidth obj = liftIO $ getObjectPropertyCInt obj "natural-width" data CellAreaContextNaturalWidthPropertyInfo instance AttrInfo CellAreaContextNaturalWidthPropertyInfo where type AttrAllowedOps CellAreaContextNaturalWidthPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint CellAreaContextNaturalWidthPropertyInfo = (~) () type AttrBaseTypeConstraint CellAreaContextNaturalWidthPropertyInfo = CellAreaContextK type AttrGetType CellAreaContextNaturalWidthPropertyInfo = Int32 type AttrLabel CellAreaContextNaturalWidthPropertyInfo = "CellAreaContext::natural-width" attrGet _ = getCellAreaContextNaturalWidth attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList CellAreaContext = '[ '("area", CellAreaContextAreaPropertyInfo), '("minimum-height", CellAreaContextMinimumHeightPropertyInfo), '("minimum-width", CellAreaContextMinimumWidthPropertyInfo), '("natural-height", CellAreaContextNaturalHeightPropertyInfo), '("natural-width", CellAreaContextNaturalWidthPropertyInfo)] -- VVV Prop "editing-canceled" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellEditableEditingCanceled :: (MonadIO m, CellEditableK o) => o -> m Bool getCellEditableEditingCanceled obj = liftIO $ getObjectPropertyBool obj "editing-canceled" setCellEditableEditingCanceled :: (MonadIO m, CellEditableK o) => o -> Bool -> m () setCellEditableEditingCanceled obj val = liftIO $ setObjectPropertyBool obj "editing-canceled" val constructCellEditableEditingCanceled :: Bool -> IO ([Char], GValue) constructCellEditableEditingCanceled val = constructObjectPropertyBool "editing-canceled" val data CellEditableEditingCanceledPropertyInfo instance AttrInfo CellEditableEditingCanceledPropertyInfo where type AttrAllowedOps CellEditableEditingCanceledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellEditableEditingCanceledPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellEditableEditingCanceledPropertyInfo = CellEditableK type AttrGetType CellEditableEditingCanceledPropertyInfo = Bool type AttrLabel CellEditableEditingCanceledPropertyInfo = "CellEditable::editing-canceled" attrGet _ = getCellEditableEditingCanceled attrSet _ = setCellEditableEditingCanceled attrConstruct _ = constructCellEditableEditingCanceled type instance AttributeList CellEditable = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("editing-canceled", CellEditableEditingCanceledPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList CellLayout = '[ ] -- VVV Prop "cell-background" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setCellRendererCellBackground :: (MonadIO m, CellRendererK o) => o -> T.Text -> m () setCellRendererCellBackground obj val = liftIO $ setObjectPropertyString obj "cell-background" val constructCellRendererCellBackground :: T.Text -> IO ([Char], GValue) constructCellRendererCellBackground val = constructObjectPropertyString "cell-background" val data CellRendererCellBackgroundPropertyInfo instance AttrInfo CellRendererCellBackgroundPropertyInfo where type AttrAllowedOps CellRendererCellBackgroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint CellRendererCellBackgroundPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererCellBackgroundPropertyInfo = CellRendererK type AttrGetType CellRendererCellBackgroundPropertyInfo = () type AttrLabel CellRendererCellBackgroundPropertyInfo = "CellRenderer::cell-background" attrGet _ = undefined attrSet _ = setCellRendererCellBackground attrConstruct _ = constructCellRendererCellBackground -- VVV Prop "cell-background-gdk" -- Type: TInterface "Gdk" "Color" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererCellBackgroundGdk :: (MonadIO m, CellRendererK o) => o -> m Gdk.Color getCellRendererCellBackgroundGdk obj = liftIO $ getObjectPropertyBoxed obj "cell-background-gdk" Gdk.Color setCellRendererCellBackgroundGdk :: (MonadIO m, CellRendererK o) => o -> Gdk.Color -> m () setCellRendererCellBackgroundGdk obj val = liftIO $ setObjectPropertyBoxed obj "cell-background-gdk" val constructCellRendererCellBackgroundGdk :: Gdk.Color -> IO ([Char], GValue) constructCellRendererCellBackgroundGdk val = constructObjectPropertyBoxed "cell-background-gdk" val data CellRendererCellBackgroundGdkPropertyInfo instance AttrInfo CellRendererCellBackgroundGdkPropertyInfo where type AttrAllowedOps CellRendererCellBackgroundGdkPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererCellBackgroundGdkPropertyInfo = (~) Gdk.Color type AttrBaseTypeConstraint CellRendererCellBackgroundGdkPropertyInfo = CellRendererK type AttrGetType CellRendererCellBackgroundGdkPropertyInfo = Gdk.Color type AttrLabel CellRendererCellBackgroundGdkPropertyInfo = "CellRenderer::cell-background-gdk" attrGet _ = getCellRendererCellBackgroundGdk attrSet _ = setCellRendererCellBackgroundGdk attrConstruct _ = constructCellRendererCellBackgroundGdk -- VVV Prop "cell-background-rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererCellBackgroundRgba :: (MonadIO m, CellRendererK o) => o -> m Gdk.RGBA getCellRendererCellBackgroundRgba obj = liftIO $ getObjectPropertyBoxed obj "cell-background-rgba" Gdk.RGBA setCellRendererCellBackgroundRgba :: (MonadIO m, CellRendererK o) => o -> Gdk.RGBA -> m () setCellRendererCellBackgroundRgba obj val = liftIO $ setObjectPropertyBoxed obj "cell-background-rgba" val constructCellRendererCellBackgroundRgba :: Gdk.RGBA -> IO ([Char], GValue) constructCellRendererCellBackgroundRgba val = constructObjectPropertyBoxed "cell-background-rgba" val data CellRendererCellBackgroundRgbaPropertyInfo instance AttrInfo CellRendererCellBackgroundRgbaPropertyInfo where type AttrAllowedOps CellRendererCellBackgroundRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererCellBackgroundRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint CellRendererCellBackgroundRgbaPropertyInfo = CellRendererK type AttrGetType CellRendererCellBackgroundRgbaPropertyInfo = Gdk.RGBA type AttrLabel CellRendererCellBackgroundRgbaPropertyInfo = "CellRenderer::cell-background-rgba" attrGet _ = getCellRendererCellBackgroundRgba attrSet _ = setCellRendererCellBackgroundRgba attrConstruct _ = constructCellRendererCellBackgroundRgba -- VVV Prop "cell-background-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererCellBackgroundSet :: (MonadIO m, CellRendererK o) => o -> m Bool getCellRendererCellBackgroundSet obj = liftIO $ getObjectPropertyBool obj "cell-background-set" setCellRendererCellBackgroundSet :: (MonadIO m, CellRendererK o) => o -> Bool -> m () setCellRendererCellBackgroundSet obj val = liftIO $ setObjectPropertyBool obj "cell-background-set" val constructCellRendererCellBackgroundSet :: Bool -> IO ([Char], GValue) constructCellRendererCellBackgroundSet val = constructObjectPropertyBool "cell-background-set" val data CellRendererCellBackgroundSetPropertyInfo instance AttrInfo CellRendererCellBackgroundSetPropertyInfo where type AttrAllowedOps CellRendererCellBackgroundSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererCellBackgroundSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererCellBackgroundSetPropertyInfo = CellRendererK type AttrGetType CellRendererCellBackgroundSetPropertyInfo = Bool type AttrLabel CellRendererCellBackgroundSetPropertyInfo = "CellRenderer::cell-background-set" attrGet _ = getCellRendererCellBackgroundSet attrSet _ = setCellRendererCellBackgroundSet attrConstruct _ = constructCellRendererCellBackgroundSet -- VVV Prop "editing" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getCellRendererEditing :: (MonadIO m, CellRendererK o) => o -> m Bool getCellRendererEditing obj = liftIO $ getObjectPropertyBool obj "editing" data CellRendererEditingPropertyInfo instance AttrInfo CellRendererEditingPropertyInfo where type AttrAllowedOps CellRendererEditingPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint CellRendererEditingPropertyInfo = (~) () type AttrBaseTypeConstraint CellRendererEditingPropertyInfo = CellRendererK type AttrGetType CellRendererEditingPropertyInfo = Bool type AttrLabel CellRendererEditingPropertyInfo = "CellRenderer::editing" attrGet _ = getCellRendererEditing attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "height" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererHeight :: (MonadIO m, CellRendererK o) => o -> m Int32 getCellRendererHeight obj = liftIO $ getObjectPropertyCInt obj "height" setCellRendererHeight :: (MonadIO m, CellRendererK o) => o -> Int32 -> m () setCellRendererHeight obj val = liftIO $ setObjectPropertyCInt obj "height" val constructCellRendererHeight :: Int32 -> IO ([Char], GValue) constructCellRendererHeight val = constructObjectPropertyCInt "height" val data CellRendererHeightPropertyInfo instance AttrInfo CellRendererHeightPropertyInfo where type AttrAllowedOps CellRendererHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererHeightPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererHeightPropertyInfo = CellRendererK type AttrGetType CellRendererHeightPropertyInfo = Int32 type AttrLabel CellRendererHeightPropertyInfo = "CellRenderer::height" attrGet _ = getCellRendererHeight attrSet _ = setCellRendererHeight attrConstruct _ = constructCellRendererHeight -- VVV Prop "is-expanded" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererIsExpanded :: (MonadIO m, CellRendererK o) => o -> m Bool getCellRendererIsExpanded obj = liftIO $ getObjectPropertyBool obj "is-expanded" setCellRendererIsExpanded :: (MonadIO m, CellRendererK o) => o -> Bool -> m () setCellRendererIsExpanded obj val = liftIO $ setObjectPropertyBool obj "is-expanded" val constructCellRendererIsExpanded :: Bool -> IO ([Char], GValue) constructCellRendererIsExpanded val = constructObjectPropertyBool "is-expanded" val data CellRendererIsExpandedPropertyInfo instance AttrInfo CellRendererIsExpandedPropertyInfo where type AttrAllowedOps CellRendererIsExpandedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererIsExpandedPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererIsExpandedPropertyInfo = CellRendererK type AttrGetType CellRendererIsExpandedPropertyInfo = Bool type AttrLabel CellRendererIsExpandedPropertyInfo = "CellRenderer::is-expanded" attrGet _ = getCellRendererIsExpanded attrSet _ = setCellRendererIsExpanded attrConstruct _ = constructCellRendererIsExpanded -- VVV Prop "is-expander" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererIsExpander :: (MonadIO m, CellRendererK o) => o -> m Bool getCellRendererIsExpander obj = liftIO $ getObjectPropertyBool obj "is-expander" setCellRendererIsExpander :: (MonadIO m, CellRendererK o) => o -> Bool -> m () setCellRendererIsExpander obj val = liftIO $ setObjectPropertyBool obj "is-expander" val constructCellRendererIsExpander :: Bool -> IO ([Char], GValue) constructCellRendererIsExpander val = constructObjectPropertyBool "is-expander" val data CellRendererIsExpanderPropertyInfo instance AttrInfo CellRendererIsExpanderPropertyInfo where type AttrAllowedOps CellRendererIsExpanderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererIsExpanderPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererIsExpanderPropertyInfo = CellRendererK type AttrGetType CellRendererIsExpanderPropertyInfo = Bool type AttrLabel CellRendererIsExpanderPropertyInfo = "CellRenderer::is-expander" attrGet _ = getCellRendererIsExpander attrSet _ = setCellRendererIsExpander attrConstruct _ = constructCellRendererIsExpander -- VVV Prop "mode" -- Type: TInterface "Gtk" "CellRendererMode" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererMode :: (MonadIO m, CellRendererK o) => o -> m CellRendererMode getCellRendererMode obj = liftIO $ getObjectPropertyEnum obj "mode" setCellRendererMode :: (MonadIO m, CellRendererK o) => o -> CellRendererMode -> m () setCellRendererMode obj val = liftIO $ setObjectPropertyEnum obj "mode" val constructCellRendererMode :: CellRendererMode -> IO ([Char], GValue) constructCellRendererMode val = constructObjectPropertyEnum "mode" val data CellRendererModePropertyInfo instance AttrInfo CellRendererModePropertyInfo where type AttrAllowedOps CellRendererModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererModePropertyInfo = (~) CellRendererMode type AttrBaseTypeConstraint CellRendererModePropertyInfo = CellRendererK type AttrGetType CellRendererModePropertyInfo = CellRendererMode type AttrLabel CellRendererModePropertyInfo = "CellRenderer::mode" attrGet _ = getCellRendererMode attrSet _ = setCellRendererMode attrConstruct _ = constructCellRendererMode -- VVV Prop "sensitive" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererSensitive :: (MonadIO m, CellRendererK o) => o -> m Bool getCellRendererSensitive obj = liftIO $ getObjectPropertyBool obj "sensitive" setCellRendererSensitive :: (MonadIO m, CellRendererK o) => o -> Bool -> m () setCellRendererSensitive obj val = liftIO $ setObjectPropertyBool obj "sensitive" val constructCellRendererSensitive :: Bool -> IO ([Char], GValue) constructCellRendererSensitive val = constructObjectPropertyBool "sensitive" val data CellRendererSensitivePropertyInfo instance AttrInfo CellRendererSensitivePropertyInfo where type AttrAllowedOps CellRendererSensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererSensitivePropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererSensitivePropertyInfo = CellRendererK type AttrGetType CellRendererSensitivePropertyInfo = Bool type AttrLabel CellRendererSensitivePropertyInfo = "CellRenderer::sensitive" attrGet _ = getCellRendererSensitive attrSet _ = setCellRendererSensitive attrConstruct _ = constructCellRendererSensitive -- VVV Prop "visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererVisible :: (MonadIO m, CellRendererK o) => o -> m Bool getCellRendererVisible obj = liftIO $ getObjectPropertyBool obj "visible" setCellRendererVisible :: (MonadIO m, CellRendererK o) => o -> Bool -> m () setCellRendererVisible obj val = liftIO $ setObjectPropertyBool obj "visible" val constructCellRendererVisible :: Bool -> IO ([Char], GValue) constructCellRendererVisible val = constructObjectPropertyBool "visible" val data CellRendererVisiblePropertyInfo instance AttrInfo CellRendererVisiblePropertyInfo where type AttrAllowedOps CellRendererVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererVisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererVisiblePropertyInfo = CellRendererK type AttrGetType CellRendererVisiblePropertyInfo = Bool type AttrLabel CellRendererVisiblePropertyInfo = "CellRenderer::visible" attrGet _ = getCellRendererVisible attrSet _ = setCellRendererVisible attrConstruct _ = constructCellRendererVisible -- VVV Prop "width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererWidth :: (MonadIO m, CellRendererK o) => o -> m Int32 getCellRendererWidth obj = liftIO $ getObjectPropertyCInt obj "width" setCellRendererWidth :: (MonadIO m, CellRendererK o) => o -> Int32 -> m () setCellRendererWidth obj val = liftIO $ setObjectPropertyCInt obj "width" val constructCellRendererWidth :: Int32 -> IO ([Char], GValue) constructCellRendererWidth val = constructObjectPropertyCInt "width" val data CellRendererWidthPropertyInfo instance AttrInfo CellRendererWidthPropertyInfo where type AttrAllowedOps CellRendererWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererWidthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererWidthPropertyInfo = CellRendererK type AttrGetType CellRendererWidthPropertyInfo = Int32 type AttrLabel CellRendererWidthPropertyInfo = "CellRenderer::width" attrGet _ = getCellRendererWidth attrSet _ = setCellRendererWidth attrConstruct _ = constructCellRendererWidth -- VVV Prop "xalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getCellRendererXalign :: (MonadIO m, CellRendererK o) => o -> m Float getCellRendererXalign obj = liftIO $ getObjectPropertyFloat obj "xalign" setCellRendererXalign :: (MonadIO m, CellRendererK o) => o -> Float -> m () setCellRendererXalign obj val = liftIO $ setObjectPropertyFloat obj "xalign" val constructCellRendererXalign :: Float -> IO ([Char], GValue) constructCellRendererXalign val = constructObjectPropertyFloat "xalign" val data CellRendererXalignPropertyInfo instance AttrInfo CellRendererXalignPropertyInfo where type AttrAllowedOps CellRendererXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererXalignPropertyInfo = (~) Float type AttrBaseTypeConstraint CellRendererXalignPropertyInfo = CellRendererK type AttrGetType CellRendererXalignPropertyInfo = Float type AttrLabel CellRendererXalignPropertyInfo = "CellRenderer::xalign" attrGet _ = getCellRendererXalign attrSet _ = setCellRendererXalign attrConstruct _ = constructCellRendererXalign -- VVV Prop "xpad" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererXpad :: (MonadIO m, CellRendererK o) => o -> m Word32 getCellRendererXpad obj = liftIO $ getObjectPropertyCUInt obj "xpad" setCellRendererXpad :: (MonadIO m, CellRendererK o) => o -> Word32 -> m () setCellRendererXpad obj val = liftIO $ setObjectPropertyCUInt obj "xpad" val constructCellRendererXpad :: Word32 -> IO ([Char], GValue) constructCellRendererXpad val = constructObjectPropertyCUInt "xpad" val data CellRendererXpadPropertyInfo instance AttrInfo CellRendererXpadPropertyInfo where type AttrAllowedOps CellRendererXpadPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererXpadPropertyInfo = (~) Word32 type AttrBaseTypeConstraint CellRendererXpadPropertyInfo = CellRendererK type AttrGetType CellRendererXpadPropertyInfo = Word32 type AttrLabel CellRendererXpadPropertyInfo = "CellRenderer::xpad" attrGet _ = getCellRendererXpad attrSet _ = setCellRendererXpad attrConstruct _ = constructCellRendererXpad -- VVV Prop "yalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getCellRendererYalign :: (MonadIO m, CellRendererK o) => o -> m Float getCellRendererYalign obj = liftIO $ getObjectPropertyFloat obj "yalign" setCellRendererYalign :: (MonadIO m, CellRendererK o) => o -> Float -> m () setCellRendererYalign obj val = liftIO $ setObjectPropertyFloat obj "yalign" val constructCellRendererYalign :: Float -> IO ([Char], GValue) constructCellRendererYalign val = constructObjectPropertyFloat "yalign" val data CellRendererYalignPropertyInfo instance AttrInfo CellRendererYalignPropertyInfo where type AttrAllowedOps CellRendererYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererYalignPropertyInfo = (~) Float type AttrBaseTypeConstraint CellRendererYalignPropertyInfo = CellRendererK type AttrGetType CellRendererYalignPropertyInfo = Float type AttrLabel CellRendererYalignPropertyInfo = "CellRenderer::yalign" attrGet _ = getCellRendererYalign attrSet _ = setCellRendererYalign attrConstruct _ = constructCellRendererYalign -- VVV Prop "ypad" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererYpad :: (MonadIO m, CellRendererK o) => o -> m Word32 getCellRendererYpad obj = liftIO $ getObjectPropertyCUInt obj "ypad" setCellRendererYpad :: (MonadIO m, CellRendererK o) => o -> Word32 -> m () setCellRendererYpad obj val = liftIO $ setObjectPropertyCUInt obj "ypad" val constructCellRendererYpad :: Word32 -> IO ([Char], GValue) constructCellRendererYpad val = constructObjectPropertyCUInt "ypad" val data CellRendererYpadPropertyInfo instance AttrInfo CellRendererYpadPropertyInfo where type AttrAllowedOps CellRendererYpadPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererYpadPropertyInfo = (~) Word32 type AttrBaseTypeConstraint CellRendererYpadPropertyInfo = CellRendererK type AttrGetType CellRendererYpadPropertyInfo = Word32 type AttrLabel CellRendererYpadPropertyInfo = "CellRenderer::ypad" attrGet _ = getCellRendererYpad attrSet _ = setCellRendererYpad attrConstruct _ = constructCellRendererYpad type instance AttributeList CellRenderer = '[ '("cell-background", CellRendererCellBackgroundPropertyInfo), '("cell-background-gdk", CellRendererCellBackgroundGdkPropertyInfo), '("cell-background-rgba", CellRendererCellBackgroundRgbaPropertyInfo), '("cell-background-set", CellRendererCellBackgroundSetPropertyInfo), '("editing", CellRendererEditingPropertyInfo), '("height", CellRendererHeightPropertyInfo), '("is-expanded", CellRendererIsExpandedPropertyInfo), '("is-expander", CellRendererIsExpanderPropertyInfo), '("mode", CellRendererModePropertyInfo), '("sensitive", CellRendererSensitivePropertyInfo), '("visible", CellRendererVisiblePropertyInfo), '("width", CellRendererWidthPropertyInfo), '("xalign", CellRendererXalignPropertyInfo), '("xpad", CellRendererXpadPropertyInfo), '("yalign", CellRendererYalignPropertyInfo), '("ypad", CellRendererYpadPropertyInfo)] -- VVV Prop "accel-key" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererAccelAccelKey :: (MonadIO m, CellRendererAccelK o) => o -> m Word32 getCellRendererAccelAccelKey obj = liftIO $ getObjectPropertyCUInt obj "accel-key" setCellRendererAccelAccelKey :: (MonadIO m, CellRendererAccelK o) => o -> Word32 -> m () setCellRendererAccelAccelKey obj val = liftIO $ setObjectPropertyCUInt obj "accel-key" val constructCellRendererAccelAccelKey :: Word32 -> IO ([Char], GValue) constructCellRendererAccelAccelKey val = constructObjectPropertyCUInt "accel-key" val data CellRendererAccelAccelKeyPropertyInfo instance AttrInfo CellRendererAccelAccelKeyPropertyInfo where type AttrAllowedOps CellRendererAccelAccelKeyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererAccelAccelKeyPropertyInfo = (~) Word32 type AttrBaseTypeConstraint CellRendererAccelAccelKeyPropertyInfo = CellRendererAccelK type AttrGetType CellRendererAccelAccelKeyPropertyInfo = Word32 type AttrLabel CellRendererAccelAccelKeyPropertyInfo = "CellRendererAccel::accel-key" attrGet _ = getCellRendererAccelAccelKey attrSet _ = setCellRendererAccelAccelKey attrConstruct _ = constructCellRendererAccelAccelKey -- VVV Prop "accel-mode" -- Type: TInterface "Gtk" "CellRendererAccelMode" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererAccelAccelMode :: (MonadIO m, CellRendererAccelK o) => o -> m CellRendererAccelMode getCellRendererAccelAccelMode obj = liftIO $ getObjectPropertyEnum obj "accel-mode" setCellRendererAccelAccelMode :: (MonadIO m, CellRendererAccelK o) => o -> CellRendererAccelMode -> m () setCellRendererAccelAccelMode obj val = liftIO $ setObjectPropertyEnum obj "accel-mode" val constructCellRendererAccelAccelMode :: CellRendererAccelMode -> IO ([Char], GValue) constructCellRendererAccelAccelMode val = constructObjectPropertyEnum "accel-mode" val data CellRendererAccelAccelModePropertyInfo instance AttrInfo CellRendererAccelAccelModePropertyInfo where type AttrAllowedOps CellRendererAccelAccelModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererAccelAccelModePropertyInfo = (~) CellRendererAccelMode type AttrBaseTypeConstraint CellRendererAccelAccelModePropertyInfo = CellRendererAccelK type AttrGetType CellRendererAccelAccelModePropertyInfo = CellRendererAccelMode type AttrLabel CellRendererAccelAccelModePropertyInfo = "CellRendererAccel::accel-mode" attrGet _ = getCellRendererAccelAccelMode attrSet _ = setCellRendererAccelAccelMode attrConstruct _ = constructCellRendererAccelAccelMode -- VVV Prop "accel-mods" -- Type: TInterface "Gdk" "ModifierType" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererAccelAccelMods :: (MonadIO m, CellRendererAccelK o) => o -> m [Gdk.ModifierType] getCellRendererAccelAccelMods obj = liftIO $ getObjectPropertyFlags obj "accel-mods" setCellRendererAccelAccelMods :: (MonadIO m, CellRendererAccelK o) => o -> [Gdk.ModifierType] -> m () setCellRendererAccelAccelMods obj val = liftIO $ setObjectPropertyFlags obj "accel-mods" val constructCellRendererAccelAccelMods :: [Gdk.ModifierType] -> IO ([Char], GValue) constructCellRendererAccelAccelMods val = constructObjectPropertyFlags "accel-mods" val data CellRendererAccelAccelModsPropertyInfo instance AttrInfo CellRendererAccelAccelModsPropertyInfo where type AttrAllowedOps CellRendererAccelAccelModsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererAccelAccelModsPropertyInfo = (~) [Gdk.ModifierType] type AttrBaseTypeConstraint CellRendererAccelAccelModsPropertyInfo = CellRendererAccelK type AttrGetType CellRendererAccelAccelModsPropertyInfo = [Gdk.ModifierType] type AttrLabel CellRendererAccelAccelModsPropertyInfo = "CellRendererAccel::accel-mods" attrGet _ = getCellRendererAccelAccelMods attrSet _ = setCellRendererAccelAccelMods attrConstruct _ = constructCellRendererAccelAccelMods -- VVV Prop "keycode" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererAccelKeycode :: (MonadIO m, CellRendererAccelK o) => o -> m Word32 getCellRendererAccelKeycode obj = liftIO $ getObjectPropertyCUInt obj "keycode" setCellRendererAccelKeycode :: (MonadIO m, CellRendererAccelK o) => o -> Word32 -> m () setCellRendererAccelKeycode obj val = liftIO $ setObjectPropertyCUInt obj "keycode" val constructCellRendererAccelKeycode :: Word32 -> IO ([Char], GValue) constructCellRendererAccelKeycode val = constructObjectPropertyCUInt "keycode" val data CellRendererAccelKeycodePropertyInfo instance AttrInfo CellRendererAccelKeycodePropertyInfo where type AttrAllowedOps CellRendererAccelKeycodePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererAccelKeycodePropertyInfo = (~) Word32 type AttrBaseTypeConstraint CellRendererAccelKeycodePropertyInfo = CellRendererAccelK type AttrGetType CellRendererAccelKeycodePropertyInfo = Word32 type AttrLabel CellRendererAccelKeycodePropertyInfo = "CellRendererAccel::keycode" attrGet _ = getCellRendererAccelKeycode attrSet _ = setCellRendererAccelKeycode attrConstruct _ = constructCellRendererAccelKeycode type instance AttributeList CellRendererAccel = '[ '("accel-key", CellRendererAccelAccelKeyPropertyInfo), '("accel-mode", CellRendererAccelAccelModePropertyInfo), '("accel-mods", CellRendererAccelAccelModsPropertyInfo), '("align-set", CellRendererTextAlignSetPropertyInfo), '("alignment", CellRendererTextAlignmentPropertyInfo), '("attributes", CellRendererTextAttributesPropertyInfo), '("background", CellRendererTextBackgroundPropertyInfo), '("background-gdk", CellRendererTextBackgroundGdkPropertyInfo), '("background-rgba", CellRendererTextBackgroundRgbaPropertyInfo), '("background-set", CellRendererTextBackgroundSetPropertyInfo), '("cell-background", CellRendererCellBackgroundPropertyInfo), '("cell-background-gdk", CellRendererCellBackgroundGdkPropertyInfo), '("cell-background-rgba", CellRendererCellBackgroundRgbaPropertyInfo), '("cell-background-set", CellRendererCellBackgroundSetPropertyInfo), '("editable", CellRendererTextEditablePropertyInfo), '("editable-set", CellRendererTextEditableSetPropertyInfo), '("editing", CellRendererEditingPropertyInfo), '("ellipsize", CellRendererTextEllipsizePropertyInfo), '("ellipsize-set", CellRendererTextEllipsizeSetPropertyInfo), '("family", CellRendererTextFamilyPropertyInfo), '("family-set", CellRendererTextFamilySetPropertyInfo), '("font", CellRendererTextFontPropertyInfo), '("font-desc", CellRendererTextFontDescPropertyInfo), '("foreground", CellRendererTextForegroundPropertyInfo), '("foreground-gdk", CellRendererTextForegroundGdkPropertyInfo), '("foreground-rgba", CellRendererTextForegroundRgbaPropertyInfo), '("foreground-set", CellRendererTextForegroundSetPropertyInfo), '("height", CellRendererHeightPropertyInfo), '("is-expanded", CellRendererIsExpandedPropertyInfo), '("is-expander", CellRendererIsExpanderPropertyInfo), '("keycode", CellRendererAccelKeycodePropertyInfo), '("language", CellRendererTextLanguagePropertyInfo), '("language-set", CellRendererTextLanguageSetPropertyInfo), '("markup", CellRendererTextMarkupPropertyInfo), '("max-width-chars", CellRendererTextMaxWidthCharsPropertyInfo), '("mode", CellRendererModePropertyInfo), '("placeholder-text", CellRendererTextPlaceholderTextPropertyInfo), '("rise", CellRendererTextRisePropertyInfo), '("rise-set", CellRendererTextRiseSetPropertyInfo), '("scale", CellRendererTextScalePropertyInfo), '("scale-set", CellRendererTextScaleSetPropertyInfo), '("sensitive", CellRendererSensitivePropertyInfo), '("single-paragraph-mode", CellRendererTextSingleParagraphModePropertyInfo), '("size", CellRendererTextSizePropertyInfo), '("size-points", CellRendererTextSizePointsPropertyInfo), '("size-set", CellRendererTextSizeSetPropertyInfo), '("stretch", CellRendererTextStretchPropertyInfo), '("stretch-set", CellRendererTextStretchSetPropertyInfo), '("strikethrough", CellRendererTextStrikethroughPropertyInfo), '("strikethrough-set", CellRendererTextStrikethroughSetPropertyInfo), '("style", CellRendererTextStylePropertyInfo), '("style-set", CellRendererTextStyleSetPropertyInfo), '("text", CellRendererTextTextPropertyInfo), '("underline", CellRendererTextUnderlinePropertyInfo), '("underline-set", CellRendererTextUnderlineSetPropertyInfo), '("variant", CellRendererTextVariantPropertyInfo), '("variant-set", CellRendererTextVariantSetPropertyInfo), '("visible", CellRendererVisiblePropertyInfo), '("weight", CellRendererTextWeightPropertyInfo), '("weight-set", CellRendererTextWeightSetPropertyInfo), '("width", CellRendererWidthPropertyInfo), '("width-chars", CellRendererTextWidthCharsPropertyInfo), '("wrap-mode", CellRendererTextWrapModePropertyInfo), '("wrap-width", CellRendererTextWrapWidthPropertyInfo), '("xalign", CellRendererXalignPropertyInfo), '("xpad", CellRendererXpadPropertyInfo), '("yalign", CellRendererYalignPropertyInfo), '("ypad", CellRendererYpadPropertyInfo)] -- VVV Prop "has-entry" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererComboHasEntry :: (MonadIO m, CellRendererComboK o) => o -> m Bool getCellRendererComboHasEntry obj = liftIO $ getObjectPropertyBool obj "has-entry" setCellRendererComboHasEntry :: (MonadIO m, CellRendererComboK o) => o -> Bool -> m () setCellRendererComboHasEntry obj val = liftIO $ setObjectPropertyBool obj "has-entry" val constructCellRendererComboHasEntry :: Bool -> IO ([Char], GValue) constructCellRendererComboHasEntry val = constructObjectPropertyBool "has-entry" val data CellRendererComboHasEntryPropertyInfo instance AttrInfo CellRendererComboHasEntryPropertyInfo where type AttrAllowedOps CellRendererComboHasEntryPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererComboHasEntryPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererComboHasEntryPropertyInfo = CellRendererComboK type AttrGetType CellRendererComboHasEntryPropertyInfo = Bool type AttrLabel CellRendererComboHasEntryPropertyInfo = "CellRendererCombo::has-entry" attrGet _ = getCellRendererComboHasEntry attrSet _ = setCellRendererComboHasEntry attrConstruct _ = constructCellRendererComboHasEntry -- VVV Prop "model" -- Type: TInterface "Gtk" "TreeModel" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererComboModel :: (MonadIO m, CellRendererComboK o) => o -> m TreeModel getCellRendererComboModel obj = liftIO $ getObjectPropertyObject obj "model" TreeModel setCellRendererComboModel :: (MonadIO m, CellRendererComboK o, TreeModelK a) => o -> a -> m () setCellRendererComboModel obj val = liftIO $ setObjectPropertyObject obj "model" val constructCellRendererComboModel :: (TreeModelK a) => a -> IO ([Char], GValue) constructCellRendererComboModel val = constructObjectPropertyObject "model" val data CellRendererComboModelPropertyInfo instance AttrInfo CellRendererComboModelPropertyInfo where type AttrAllowedOps CellRendererComboModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererComboModelPropertyInfo = TreeModelK type AttrBaseTypeConstraint CellRendererComboModelPropertyInfo = CellRendererComboK type AttrGetType CellRendererComboModelPropertyInfo = TreeModel type AttrLabel CellRendererComboModelPropertyInfo = "CellRendererCombo::model" attrGet _ = getCellRendererComboModel attrSet _ = setCellRendererComboModel attrConstruct _ = constructCellRendererComboModel -- VVV Prop "text-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererComboTextColumn :: (MonadIO m, CellRendererComboK o) => o -> m Int32 getCellRendererComboTextColumn obj = liftIO $ getObjectPropertyCInt obj "text-column" setCellRendererComboTextColumn :: (MonadIO m, CellRendererComboK o) => o -> Int32 -> m () setCellRendererComboTextColumn obj val = liftIO $ setObjectPropertyCInt obj "text-column" val constructCellRendererComboTextColumn :: Int32 -> IO ([Char], GValue) constructCellRendererComboTextColumn val = constructObjectPropertyCInt "text-column" val data CellRendererComboTextColumnPropertyInfo instance AttrInfo CellRendererComboTextColumnPropertyInfo where type AttrAllowedOps CellRendererComboTextColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererComboTextColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererComboTextColumnPropertyInfo = CellRendererComboK type AttrGetType CellRendererComboTextColumnPropertyInfo = Int32 type AttrLabel CellRendererComboTextColumnPropertyInfo = "CellRendererCombo::text-column" attrGet _ = getCellRendererComboTextColumn attrSet _ = setCellRendererComboTextColumn attrConstruct _ = constructCellRendererComboTextColumn type instance AttributeList CellRendererCombo = '[ '("align-set", CellRendererTextAlignSetPropertyInfo), '("alignment", CellRendererTextAlignmentPropertyInfo), '("attributes", CellRendererTextAttributesPropertyInfo), '("background", CellRendererTextBackgroundPropertyInfo), '("background-gdk", CellRendererTextBackgroundGdkPropertyInfo), '("background-rgba", CellRendererTextBackgroundRgbaPropertyInfo), '("background-set", CellRendererTextBackgroundSetPropertyInfo), '("cell-background", CellRendererCellBackgroundPropertyInfo), '("cell-background-gdk", CellRendererCellBackgroundGdkPropertyInfo), '("cell-background-rgba", CellRendererCellBackgroundRgbaPropertyInfo), '("cell-background-set", CellRendererCellBackgroundSetPropertyInfo), '("editable", CellRendererTextEditablePropertyInfo), '("editable-set", CellRendererTextEditableSetPropertyInfo), '("editing", CellRendererEditingPropertyInfo), '("ellipsize", CellRendererTextEllipsizePropertyInfo), '("ellipsize-set", CellRendererTextEllipsizeSetPropertyInfo), '("family", CellRendererTextFamilyPropertyInfo), '("family-set", CellRendererTextFamilySetPropertyInfo), '("font", CellRendererTextFontPropertyInfo), '("font-desc", CellRendererTextFontDescPropertyInfo), '("foreground", CellRendererTextForegroundPropertyInfo), '("foreground-gdk", CellRendererTextForegroundGdkPropertyInfo), '("foreground-rgba", CellRendererTextForegroundRgbaPropertyInfo), '("foreground-set", CellRendererTextForegroundSetPropertyInfo), '("has-entry", CellRendererComboHasEntryPropertyInfo), '("height", CellRendererHeightPropertyInfo), '("is-expanded", CellRendererIsExpandedPropertyInfo), '("is-expander", CellRendererIsExpanderPropertyInfo), '("language", CellRendererTextLanguagePropertyInfo), '("language-set", CellRendererTextLanguageSetPropertyInfo), '("markup", CellRendererTextMarkupPropertyInfo), '("max-width-chars", CellRendererTextMaxWidthCharsPropertyInfo), '("mode", CellRendererModePropertyInfo), '("model", CellRendererComboModelPropertyInfo), '("placeholder-text", CellRendererTextPlaceholderTextPropertyInfo), '("rise", CellRendererTextRisePropertyInfo), '("rise-set", CellRendererTextRiseSetPropertyInfo), '("scale", CellRendererTextScalePropertyInfo), '("scale-set", CellRendererTextScaleSetPropertyInfo), '("sensitive", CellRendererSensitivePropertyInfo), '("single-paragraph-mode", CellRendererTextSingleParagraphModePropertyInfo), '("size", CellRendererTextSizePropertyInfo), '("size-points", CellRendererTextSizePointsPropertyInfo), '("size-set", CellRendererTextSizeSetPropertyInfo), '("stretch", CellRendererTextStretchPropertyInfo), '("stretch-set", CellRendererTextStretchSetPropertyInfo), '("strikethrough", CellRendererTextStrikethroughPropertyInfo), '("strikethrough-set", CellRendererTextStrikethroughSetPropertyInfo), '("style", CellRendererTextStylePropertyInfo), '("style-set", CellRendererTextStyleSetPropertyInfo), '("text", CellRendererTextTextPropertyInfo), '("text-column", CellRendererComboTextColumnPropertyInfo), '("underline", CellRendererTextUnderlinePropertyInfo), '("underline-set", CellRendererTextUnderlineSetPropertyInfo), '("variant", CellRendererTextVariantPropertyInfo), '("variant-set", CellRendererTextVariantSetPropertyInfo), '("visible", CellRendererVisiblePropertyInfo), '("weight", CellRendererTextWeightPropertyInfo), '("weight-set", CellRendererTextWeightSetPropertyInfo), '("width", CellRendererWidthPropertyInfo), '("width-chars", CellRendererTextWidthCharsPropertyInfo), '("wrap-mode", CellRendererTextWrapModePropertyInfo), '("wrap-width", CellRendererTextWrapWidthPropertyInfo), '("xalign", CellRendererXalignPropertyInfo), '("xpad", CellRendererXpadPropertyInfo), '("yalign", CellRendererYalignPropertyInfo), '("ypad", CellRendererYpadPropertyInfo)] -- VVV Prop "follow-state" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererPixbufFollowState :: (MonadIO m, CellRendererPixbufK o) => o -> m Bool getCellRendererPixbufFollowState obj = liftIO $ getObjectPropertyBool obj "follow-state" setCellRendererPixbufFollowState :: (MonadIO m, CellRendererPixbufK o) => o -> Bool -> m () setCellRendererPixbufFollowState obj val = liftIO $ setObjectPropertyBool obj "follow-state" val constructCellRendererPixbufFollowState :: Bool -> IO ([Char], GValue) constructCellRendererPixbufFollowState val = constructObjectPropertyBool "follow-state" val data CellRendererPixbufFollowStatePropertyInfo instance AttrInfo CellRendererPixbufFollowStatePropertyInfo where type AttrAllowedOps CellRendererPixbufFollowStatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererPixbufFollowStatePropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererPixbufFollowStatePropertyInfo = CellRendererPixbufK type AttrGetType CellRendererPixbufFollowStatePropertyInfo = Bool type AttrLabel CellRendererPixbufFollowStatePropertyInfo = "CellRendererPixbuf::follow-state" attrGet _ = getCellRendererPixbufFollowState attrSet _ = setCellRendererPixbufFollowState attrConstruct _ = constructCellRendererPixbufFollowState -- VVV Prop "gicon" -- Type: TInterface "Gio" "Icon" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererPixbufGicon :: (MonadIO m, CellRendererPixbufK o) => o -> m Gio.Icon getCellRendererPixbufGicon obj = liftIO $ getObjectPropertyObject obj "gicon" Gio.Icon setCellRendererPixbufGicon :: (MonadIO m, CellRendererPixbufK o, Gio.IconK a) => o -> a -> m () setCellRendererPixbufGicon obj val = liftIO $ setObjectPropertyObject obj "gicon" val constructCellRendererPixbufGicon :: (Gio.IconK a) => a -> IO ([Char], GValue) constructCellRendererPixbufGicon val = constructObjectPropertyObject "gicon" val data CellRendererPixbufGiconPropertyInfo instance AttrInfo CellRendererPixbufGiconPropertyInfo where type AttrAllowedOps CellRendererPixbufGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererPixbufGiconPropertyInfo = Gio.IconK type AttrBaseTypeConstraint CellRendererPixbufGiconPropertyInfo = CellRendererPixbufK type AttrGetType CellRendererPixbufGiconPropertyInfo = Gio.Icon type AttrLabel CellRendererPixbufGiconPropertyInfo = "CellRendererPixbuf::gicon" attrGet _ = getCellRendererPixbufGicon attrSet _ = setCellRendererPixbufGicon attrConstruct _ = constructCellRendererPixbufGicon -- VVV Prop "icon-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererPixbufIconName :: (MonadIO m, CellRendererPixbufK o) => o -> m T.Text getCellRendererPixbufIconName obj = liftIO $ getObjectPropertyString obj "icon-name" setCellRendererPixbufIconName :: (MonadIO m, CellRendererPixbufK o) => o -> T.Text -> m () setCellRendererPixbufIconName obj val = liftIO $ setObjectPropertyString obj "icon-name" val constructCellRendererPixbufIconName :: T.Text -> IO ([Char], GValue) constructCellRendererPixbufIconName val = constructObjectPropertyString "icon-name" val data CellRendererPixbufIconNamePropertyInfo instance AttrInfo CellRendererPixbufIconNamePropertyInfo where type AttrAllowedOps CellRendererPixbufIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererPixbufIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererPixbufIconNamePropertyInfo = CellRendererPixbufK type AttrGetType CellRendererPixbufIconNamePropertyInfo = T.Text type AttrLabel CellRendererPixbufIconNamePropertyInfo = "CellRendererPixbuf::icon-name" attrGet _ = getCellRendererPixbufIconName attrSet _ = setCellRendererPixbufIconName attrConstruct _ = constructCellRendererPixbufIconName -- VVV Prop "pixbuf" -- Type: TInterface "GdkPixbuf" "Pixbuf" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererPixbufPixbuf :: (MonadIO m, CellRendererPixbufK o) => o -> m GdkPixbuf.Pixbuf getCellRendererPixbufPixbuf obj = liftIO $ getObjectPropertyObject obj "pixbuf" GdkPixbuf.Pixbuf setCellRendererPixbufPixbuf :: (MonadIO m, CellRendererPixbufK o, GdkPixbuf.PixbufK a) => o -> a -> m () setCellRendererPixbufPixbuf obj val = liftIO $ setObjectPropertyObject obj "pixbuf" val constructCellRendererPixbufPixbuf :: (GdkPixbuf.PixbufK a) => a -> IO ([Char], GValue) constructCellRendererPixbufPixbuf val = constructObjectPropertyObject "pixbuf" val data CellRendererPixbufPixbufPropertyInfo instance AttrInfo CellRendererPixbufPixbufPropertyInfo where type AttrAllowedOps CellRendererPixbufPixbufPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererPixbufPixbufPropertyInfo = GdkPixbuf.PixbufK type AttrBaseTypeConstraint CellRendererPixbufPixbufPropertyInfo = CellRendererPixbufK type AttrGetType CellRendererPixbufPixbufPropertyInfo = GdkPixbuf.Pixbuf type AttrLabel CellRendererPixbufPixbufPropertyInfo = "CellRendererPixbuf::pixbuf" attrGet _ = getCellRendererPixbufPixbuf attrSet _ = setCellRendererPixbufPixbuf attrConstruct _ = constructCellRendererPixbufPixbuf -- VVV Prop "pixbuf-expander-closed" -- Type: TInterface "GdkPixbuf" "Pixbuf" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererPixbufPixbufExpanderClosed :: (MonadIO m, CellRendererPixbufK o) => o -> m GdkPixbuf.Pixbuf getCellRendererPixbufPixbufExpanderClosed obj = liftIO $ getObjectPropertyObject obj "pixbuf-expander-closed" GdkPixbuf.Pixbuf setCellRendererPixbufPixbufExpanderClosed :: (MonadIO m, CellRendererPixbufK o, GdkPixbuf.PixbufK a) => o -> a -> m () setCellRendererPixbufPixbufExpanderClosed obj val = liftIO $ setObjectPropertyObject obj "pixbuf-expander-closed" val constructCellRendererPixbufPixbufExpanderClosed :: (GdkPixbuf.PixbufK a) => a -> IO ([Char], GValue) constructCellRendererPixbufPixbufExpanderClosed val = constructObjectPropertyObject "pixbuf-expander-closed" val data CellRendererPixbufPixbufExpanderClosedPropertyInfo instance AttrInfo CellRendererPixbufPixbufExpanderClosedPropertyInfo where type AttrAllowedOps CellRendererPixbufPixbufExpanderClosedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererPixbufPixbufExpanderClosedPropertyInfo = GdkPixbuf.PixbufK type AttrBaseTypeConstraint CellRendererPixbufPixbufExpanderClosedPropertyInfo = CellRendererPixbufK type AttrGetType CellRendererPixbufPixbufExpanderClosedPropertyInfo = GdkPixbuf.Pixbuf type AttrLabel CellRendererPixbufPixbufExpanderClosedPropertyInfo = "CellRendererPixbuf::pixbuf-expander-closed" attrGet _ = getCellRendererPixbufPixbufExpanderClosed attrSet _ = setCellRendererPixbufPixbufExpanderClosed attrConstruct _ = constructCellRendererPixbufPixbufExpanderClosed -- VVV Prop "pixbuf-expander-open" -- Type: TInterface "GdkPixbuf" "Pixbuf" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererPixbufPixbufExpanderOpen :: (MonadIO m, CellRendererPixbufK o) => o -> m GdkPixbuf.Pixbuf getCellRendererPixbufPixbufExpanderOpen obj = liftIO $ getObjectPropertyObject obj "pixbuf-expander-open" GdkPixbuf.Pixbuf setCellRendererPixbufPixbufExpanderOpen :: (MonadIO m, CellRendererPixbufK o, GdkPixbuf.PixbufK a) => o -> a -> m () setCellRendererPixbufPixbufExpanderOpen obj val = liftIO $ setObjectPropertyObject obj "pixbuf-expander-open" val constructCellRendererPixbufPixbufExpanderOpen :: (GdkPixbuf.PixbufK a) => a -> IO ([Char], GValue) constructCellRendererPixbufPixbufExpanderOpen val = constructObjectPropertyObject "pixbuf-expander-open" val data CellRendererPixbufPixbufExpanderOpenPropertyInfo instance AttrInfo CellRendererPixbufPixbufExpanderOpenPropertyInfo where type AttrAllowedOps CellRendererPixbufPixbufExpanderOpenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererPixbufPixbufExpanderOpenPropertyInfo = GdkPixbuf.PixbufK type AttrBaseTypeConstraint CellRendererPixbufPixbufExpanderOpenPropertyInfo = CellRendererPixbufK type AttrGetType CellRendererPixbufPixbufExpanderOpenPropertyInfo = GdkPixbuf.Pixbuf type AttrLabel CellRendererPixbufPixbufExpanderOpenPropertyInfo = "CellRendererPixbuf::pixbuf-expander-open" attrGet _ = getCellRendererPixbufPixbufExpanderOpen attrSet _ = setCellRendererPixbufPixbufExpanderOpen attrConstruct _ = constructCellRendererPixbufPixbufExpanderOpen -- VVV Prop "stock-detail" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererPixbufStockDetail :: (MonadIO m, CellRendererPixbufK o) => o -> m T.Text getCellRendererPixbufStockDetail obj = liftIO $ getObjectPropertyString obj "stock-detail" setCellRendererPixbufStockDetail :: (MonadIO m, CellRendererPixbufK o) => o -> T.Text -> m () setCellRendererPixbufStockDetail obj val = liftIO $ setObjectPropertyString obj "stock-detail" val constructCellRendererPixbufStockDetail :: T.Text -> IO ([Char], GValue) constructCellRendererPixbufStockDetail val = constructObjectPropertyString "stock-detail" val data CellRendererPixbufStockDetailPropertyInfo instance AttrInfo CellRendererPixbufStockDetailPropertyInfo where type AttrAllowedOps CellRendererPixbufStockDetailPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererPixbufStockDetailPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererPixbufStockDetailPropertyInfo = CellRendererPixbufK type AttrGetType CellRendererPixbufStockDetailPropertyInfo = T.Text type AttrLabel CellRendererPixbufStockDetailPropertyInfo = "CellRendererPixbuf::stock-detail" attrGet _ = getCellRendererPixbufStockDetail attrSet _ = setCellRendererPixbufStockDetail attrConstruct _ = constructCellRendererPixbufStockDetail -- VVV Prop "stock-id" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererPixbufStockId :: (MonadIO m, CellRendererPixbufK o) => o -> m T.Text getCellRendererPixbufStockId obj = liftIO $ getObjectPropertyString obj "stock-id" setCellRendererPixbufStockId :: (MonadIO m, CellRendererPixbufK o) => o -> T.Text -> m () setCellRendererPixbufStockId obj val = liftIO $ setObjectPropertyString obj "stock-id" val constructCellRendererPixbufStockId :: T.Text -> IO ([Char], GValue) constructCellRendererPixbufStockId val = constructObjectPropertyString "stock-id" val data CellRendererPixbufStockIdPropertyInfo instance AttrInfo CellRendererPixbufStockIdPropertyInfo where type AttrAllowedOps CellRendererPixbufStockIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererPixbufStockIdPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererPixbufStockIdPropertyInfo = CellRendererPixbufK type AttrGetType CellRendererPixbufStockIdPropertyInfo = T.Text type AttrLabel CellRendererPixbufStockIdPropertyInfo = "CellRendererPixbuf::stock-id" attrGet _ = getCellRendererPixbufStockId attrSet _ = setCellRendererPixbufStockId attrConstruct _ = constructCellRendererPixbufStockId -- VVV Prop "stock-size" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererPixbufStockSize :: (MonadIO m, CellRendererPixbufK o) => o -> m Word32 getCellRendererPixbufStockSize obj = liftIO $ getObjectPropertyCUInt obj "stock-size" setCellRendererPixbufStockSize :: (MonadIO m, CellRendererPixbufK o) => o -> Word32 -> m () setCellRendererPixbufStockSize obj val = liftIO $ setObjectPropertyCUInt obj "stock-size" val constructCellRendererPixbufStockSize :: Word32 -> IO ([Char], GValue) constructCellRendererPixbufStockSize val = constructObjectPropertyCUInt "stock-size" val data CellRendererPixbufStockSizePropertyInfo instance AttrInfo CellRendererPixbufStockSizePropertyInfo where type AttrAllowedOps CellRendererPixbufStockSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererPixbufStockSizePropertyInfo = (~) Word32 type AttrBaseTypeConstraint CellRendererPixbufStockSizePropertyInfo = CellRendererPixbufK type AttrGetType CellRendererPixbufStockSizePropertyInfo = Word32 type AttrLabel CellRendererPixbufStockSizePropertyInfo = "CellRendererPixbuf::stock-size" attrGet _ = getCellRendererPixbufStockSize attrSet _ = setCellRendererPixbufStockSize attrConstruct _ = constructCellRendererPixbufStockSize -- VVV Prop "surface" -- Type: TInterface "cairo" "Surface" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererPixbufSurface :: (MonadIO m, CellRendererPixbufK o) => o -> m Cairo.Surface getCellRendererPixbufSurface obj = liftIO $ getObjectPropertyBoxed obj "surface" Cairo.Surface setCellRendererPixbufSurface :: (MonadIO m, CellRendererPixbufK o) => o -> Cairo.Surface -> m () setCellRendererPixbufSurface obj val = liftIO $ setObjectPropertyBoxed obj "surface" val constructCellRendererPixbufSurface :: Cairo.Surface -> IO ([Char], GValue) constructCellRendererPixbufSurface val = constructObjectPropertyBoxed "surface" val data CellRendererPixbufSurfacePropertyInfo instance AttrInfo CellRendererPixbufSurfacePropertyInfo where type AttrAllowedOps CellRendererPixbufSurfacePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererPixbufSurfacePropertyInfo = (~) Cairo.Surface type AttrBaseTypeConstraint CellRendererPixbufSurfacePropertyInfo = CellRendererPixbufK type AttrGetType CellRendererPixbufSurfacePropertyInfo = Cairo.Surface type AttrLabel CellRendererPixbufSurfacePropertyInfo = "CellRendererPixbuf::surface" attrGet _ = getCellRendererPixbufSurface attrSet _ = setCellRendererPixbufSurface attrConstruct _ = constructCellRendererPixbufSurface type instance AttributeList CellRendererPixbuf = '[ '("cell-background", CellRendererCellBackgroundPropertyInfo), '("cell-background-gdk", CellRendererCellBackgroundGdkPropertyInfo), '("cell-background-rgba", CellRendererCellBackgroundRgbaPropertyInfo), '("cell-background-set", CellRendererCellBackgroundSetPropertyInfo), '("editing", CellRendererEditingPropertyInfo), '("follow-state", CellRendererPixbufFollowStatePropertyInfo), '("gicon", CellRendererPixbufGiconPropertyInfo), '("height", CellRendererHeightPropertyInfo), '("icon-name", CellRendererPixbufIconNamePropertyInfo), '("is-expanded", CellRendererIsExpandedPropertyInfo), '("is-expander", CellRendererIsExpanderPropertyInfo), '("mode", CellRendererModePropertyInfo), '("pixbuf", CellRendererPixbufPixbufPropertyInfo), '("pixbuf-expander-closed", CellRendererPixbufPixbufExpanderClosedPropertyInfo), '("pixbuf-expander-open", CellRendererPixbufPixbufExpanderOpenPropertyInfo), '("sensitive", CellRendererSensitivePropertyInfo), '("stock-detail", CellRendererPixbufStockDetailPropertyInfo), '("stock-id", CellRendererPixbufStockIdPropertyInfo), '("stock-size", CellRendererPixbufStockSizePropertyInfo), '("surface", CellRendererPixbufSurfacePropertyInfo), '("visible", CellRendererVisiblePropertyInfo), '("width", CellRendererWidthPropertyInfo), '("xalign", CellRendererXalignPropertyInfo), '("xpad", CellRendererXpadPropertyInfo), '("yalign", CellRendererYalignPropertyInfo), '("ypad", CellRendererYpadPropertyInfo)] -- VVV Prop "inverted" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererProgressInverted :: (MonadIO m, CellRendererProgressK o) => o -> m Bool getCellRendererProgressInverted obj = liftIO $ getObjectPropertyBool obj "inverted" setCellRendererProgressInverted :: (MonadIO m, CellRendererProgressK o) => o -> Bool -> m () setCellRendererProgressInverted obj val = liftIO $ setObjectPropertyBool obj "inverted" val constructCellRendererProgressInverted :: Bool -> IO ([Char], GValue) constructCellRendererProgressInverted val = constructObjectPropertyBool "inverted" val data CellRendererProgressInvertedPropertyInfo instance AttrInfo CellRendererProgressInvertedPropertyInfo where type AttrAllowedOps CellRendererProgressInvertedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererProgressInvertedPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererProgressInvertedPropertyInfo = CellRendererProgressK type AttrGetType CellRendererProgressInvertedPropertyInfo = Bool type AttrLabel CellRendererProgressInvertedPropertyInfo = "CellRendererProgress::inverted" attrGet _ = getCellRendererProgressInverted attrSet _ = setCellRendererProgressInverted attrConstruct _ = constructCellRendererProgressInverted -- VVV Prop "pulse" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererProgressPulse :: (MonadIO m, CellRendererProgressK o) => o -> m Int32 getCellRendererProgressPulse obj = liftIO $ getObjectPropertyCInt obj "pulse" setCellRendererProgressPulse :: (MonadIO m, CellRendererProgressK o) => o -> Int32 -> m () setCellRendererProgressPulse obj val = liftIO $ setObjectPropertyCInt obj "pulse" val constructCellRendererProgressPulse :: Int32 -> IO ([Char], GValue) constructCellRendererProgressPulse val = constructObjectPropertyCInt "pulse" val data CellRendererProgressPulsePropertyInfo instance AttrInfo CellRendererProgressPulsePropertyInfo where type AttrAllowedOps CellRendererProgressPulsePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererProgressPulsePropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererProgressPulsePropertyInfo = CellRendererProgressK type AttrGetType CellRendererProgressPulsePropertyInfo = Int32 type AttrLabel CellRendererProgressPulsePropertyInfo = "CellRendererProgress::pulse" attrGet _ = getCellRendererProgressPulse attrSet _ = setCellRendererProgressPulse attrConstruct _ = constructCellRendererProgressPulse -- VVV Prop "text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererProgressText :: (MonadIO m, CellRendererProgressK o) => o -> m T.Text getCellRendererProgressText obj = liftIO $ getObjectPropertyString obj "text" setCellRendererProgressText :: (MonadIO m, CellRendererProgressK o) => o -> T.Text -> m () setCellRendererProgressText obj val = liftIO $ setObjectPropertyString obj "text" val constructCellRendererProgressText :: T.Text -> IO ([Char], GValue) constructCellRendererProgressText val = constructObjectPropertyString "text" val data CellRendererProgressTextPropertyInfo instance AttrInfo CellRendererProgressTextPropertyInfo where type AttrAllowedOps CellRendererProgressTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererProgressTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererProgressTextPropertyInfo = CellRendererProgressK type AttrGetType CellRendererProgressTextPropertyInfo = T.Text type AttrLabel CellRendererProgressTextPropertyInfo = "CellRendererProgress::text" attrGet _ = getCellRendererProgressText attrSet _ = setCellRendererProgressText attrConstruct _ = constructCellRendererProgressText -- VVV Prop "text-xalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getCellRendererProgressTextXalign :: (MonadIO m, CellRendererProgressK o) => o -> m Float getCellRendererProgressTextXalign obj = liftIO $ getObjectPropertyFloat obj "text-xalign" setCellRendererProgressTextXalign :: (MonadIO m, CellRendererProgressK o) => o -> Float -> m () setCellRendererProgressTextXalign obj val = liftIO $ setObjectPropertyFloat obj "text-xalign" val constructCellRendererProgressTextXalign :: Float -> IO ([Char], GValue) constructCellRendererProgressTextXalign val = constructObjectPropertyFloat "text-xalign" val data CellRendererProgressTextXalignPropertyInfo instance AttrInfo CellRendererProgressTextXalignPropertyInfo where type AttrAllowedOps CellRendererProgressTextXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererProgressTextXalignPropertyInfo = (~) Float type AttrBaseTypeConstraint CellRendererProgressTextXalignPropertyInfo = CellRendererProgressK type AttrGetType CellRendererProgressTextXalignPropertyInfo = Float type AttrLabel CellRendererProgressTextXalignPropertyInfo = "CellRendererProgress::text-xalign" attrGet _ = getCellRendererProgressTextXalign attrSet _ = setCellRendererProgressTextXalign attrConstruct _ = constructCellRendererProgressTextXalign -- VVV Prop "text-yalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getCellRendererProgressTextYalign :: (MonadIO m, CellRendererProgressK o) => o -> m Float getCellRendererProgressTextYalign obj = liftIO $ getObjectPropertyFloat obj "text-yalign" setCellRendererProgressTextYalign :: (MonadIO m, CellRendererProgressK o) => o -> Float -> m () setCellRendererProgressTextYalign obj val = liftIO $ setObjectPropertyFloat obj "text-yalign" val constructCellRendererProgressTextYalign :: Float -> IO ([Char], GValue) constructCellRendererProgressTextYalign val = constructObjectPropertyFloat "text-yalign" val data CellRendererProgressTextYalignPropertyInfo instance AttrInfo CellRendererProgressTextYalignPropertyInfo where type AttrAllowedOps CellRendererProgressTextYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererProgressTextYalignPropertyInfo = (~) Float type AttrBaseTypeConstraint CellRendererProgressTextYalignPropertyInfo = CellRendererProgressK type AttrGetType CellRendererProgressTextYalignPropertyInfo = Float type AttrLabel CellRendererProgressTextYalignPropertyInfo = "CellRendererProgress::text-yalign" attrGet _ = getCellRendererProgressTextYalign attrSet _ = setCellRendererProgressTextYalign attrConstruct _ = constructCellRendererProgressTextYalign -- VVV Prop "value" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererProgressValue :: (MonadIO m, CellRendererProgressK o) => o -> m Int32 getCellRendererProgressValue obj = liftIO $ getObjectPropertyCInt obj "value" setCellRendererProgressValue :: (MonadIO m, CellRendererProgressK o) => o -> Int32 -> m () setCellRendererProgressValue obj val = liftIO $ setObjectPropertyCInt obj "value" val constructCellRendererProgressValue :: Int32 -> IO ([Char], GValue) constructCellRendererProgressValue val = constructObjectPropertyCInt "value" val data CellRendererProgressValuePropertyInfo instance AttrInfo CellRendererProgressValuePropertyInfo where type AttrAllowedOps CellRendererProgressValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererProgressValuePropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererProgressValuePropertyInfo = CellRendererProgressK type AttrGetType CellRendererProgressValuePropertyInfo = Int32 type AttrLabel CellRendererProgressValuePropertyInfo = "CellRendererProgress::value" attrGet _ = getCellRendererProgressValue attrSet _ = setCellRendererProgressValue attrConstruct _ = constructCellRendererProgressValue type instance AttributeList CellRendererProgress = '[ '("cell-background", CellRendererCellBackgroundPropertyInfo), '("cell-background-gdk", CellRendererCellBackgroundGdkPropertyInfo), '("cell-background-rgba", CellRendererCellBackgroundRgbaPropertyInfo), '("cell-background-set", CellRendererCellBackgroundSetPropertyInfo), '("editing", CellRendererEditingPropertyInfo), '("height", CellRendererHeightPropertyInfo), '("inverted", CellRendererProgressInvertedPropertyInfo), '("is-expanded", CellRendererIsExpandedPropertyInfo), '("is-expander", CellRendererIsExpanderPropertyInfo), '("mode", CellRendererModePropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("pulse", CellRendererProgressPulsePropertyInfo), '("sensitive", CellRendererSensitivePropertyInfo), '("text", CellRendererProgressTextPropertyInfo), '("text-xalign", CellRendererProgressTextXalignPropertyInfo), '("text-yalign", CellRendererProgressTextYalignPropertyInfo), '("value", CellRendererProgressValuePropertyInfo), '("visible", CellRendererVisiblePropertyInfo), '("width", CellRendererWidthPropertyInfo), '("xalign", CellRendererXalignPropertyInfo), '("xpad", CellRendererXpadPropertyInfo), '("yalign", CellRendererYalignPropertyInfo), '("ypad", CellRendererYpadPropertyInfo)] -- VVV Prop "adjustment" -- Type: TInterface "Gtk" "Adjustment" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererSpinAdjustment :: (MonadIO m, CellRendererSpinK o) => o -> m Adjustment getCellRendererSpinAdjustment obj = liftIO $ getObjectPropertyObject obj "adjustment" Adjustment setCellRendererSpinAdjustment :: (MonadIO m, CellRendererSpinK o, AdjustmentK a) => o -> a -> m () setCellRendererSpinAdjustment obj val = liftIO $ setObjectPropertyObject obj "adjustment" val constructCellRendererSpinAdjustment :: (AdjustmentK a) => a -> IO ([Char], GValue) constructCellRendererSpinAdjustment val = constructObjectPropertyObject "adjustment" val data CellRendererSpinAdjustmentPropertyInfo instance AttrInfo CellRendererSpinAdjustmentPropertyInfo where type AttrAllowedOps CellRendererSpinAdjustmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererSpinAdjustmentPropertyInfo = AdjustmentK type AttrBaseTypeConstraint CellRendererSpinAdjustmentPropertyInfo = CellRendererSpinK type AttrGetType CellRendererSpinAdjustmentPropertyInfo = Adjustment type AttrLabel CellRendererSpinAdjustmentPropertyInfo = "CellRendererSpin::adjustment" attrGet _ = getCellRendererSpinAdjustment attrSet _ = setCellRendererSpinAdjustment attrConstruct _ = constructCellRendererSpinAdjustment -- VVV Prop "climb-rate" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getCellRendererSpinClimbRate :: (MonadIO m, CellRendererSpinK o) => o -> m Double getCellRendererSpinClimbRate obj = liftIO $ getObjectPropertyDouble obj "climb-rate" setCellRendererSpinClimbRate :: (MonadIO m, CellRendererSpinK o) => o -> Double -> m () setCellRendererSpinClimbRate obj val = liftIO $ setObjectPropertyDouble obj "climb-rate" val constructCellRendererSpinClimbRate :: Double -> IO ([Char], GValue) constructCellRendererSpinClimbRate val = constructObjectPropertyDouble "climb-rate" val data CellRendererSpinClimbRatePropertyInfo instance AttrInfo CellRendererSpinClimbRatePropertyInfo where type AttrAllowedOps CellRendererSpinClimbRatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererSpinClimbRatePropertyInfo = (~) Double type AttrBaseTypeConstraint CellRendererSpinClimbRatePropertyInfo = CellRendererSpinK type AttrGetType CellRendererSpinClimbRatePropertyInfo = Double type AttrLabel CellRendererSpinClimbRatePropertyInfo = "CellRendererSpin::climb-rate" attrGet _ = getCellRendererSpinClimbRate attrSet _ = setCellRendererSpinClimbRate attrConstruct _ = constructCellRendererSpinClimbRate -- VVV Prop "digits" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererSpinDigits :: (MonadIO m, CellRendererSpinK o) => o -> m Word32 getCellRendererSpinDigits obj = liftIO $ getObjectPropertyCUInt obj "digits" setCellRendererSpinDigits :: (MonadIO m, CellRendererSpinK o) => o -> Word32 -> m () setCellRendererSpinDigits obj val = liftIO $ setObjectPropertyCUInt obj "digits" val constructCellRendererSpinDigits :: Word32 -> IO ([Char], GValue) constructCellRendererSpinDigits val = constructObjectPropertyCUInt "digits" val data CellRendererSpinDigitsPropertyInfo instance AttrInfo CellRendererSpinDigitsPropertyInfo where type AttrAllowedOps CellRendererSpinDigitsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererSpinDigitsPropertyInfo = (~) Word32 type AttrBaseTypeConstraint CellRendererSpinDigitsPropertyInfo = CellRendererSpinK type AttrGetType CellRendererSpinDigitsPropertyInfo = Word32 type AttrLabel CellRendererSpinDigitsPropertyInfo = "CellRendererSpin::digits" attrGet _ = getCellRendererSpinDigits attrSet _ = setCellRendererSpinDigits attrConstruct _ = constructCellRendererSpinDigits type instance AttributeList CellRendererSpin = '[ '("adjustment", CellRendererSpinAdjustmentPropertyInfo), '("align-set", CellRendererTextAlignSetPropertyInfo), '("alignment", CellRendererTextAlignmentPropertyInfo), '("attributes", CellRendererTextAttributesPropertyInfo), '("background", CellRendererTextBackgroundPropertyInfo), '("background-gdk", CellRendererTextBackgroundGdkPropertyInfo), '("background-rgba", CellRendererTextBackgroundRgbaPropertyInfo), '("background-set", CellRendererTextBackgroundSetPropertyInfo), '("cell-background", CellRendererCellBackgroundPropertyInfo), '("cell-background-gdk", CellRendererCellBackgroundGdkPropertyInfo), '("cell-background-rgba", CellRendererCellBackgroundRgbaPropertyInfo), '("cell-background-set", CellRendererCellBackgroundSetPropertyInfo), '("climb-rate", CellRendererSpinClimbRatePropertyInfo), '("digits", CellRendererSpinDigitsPropertyInfo), '("editable", CellRendererTextEditablePropertyInfo), '("editable-set", CellRendererTextEditableSetPropertyInfo), '("editing", CellRendererEditingPropertyInfo), '("ellipsize", CellRendererTextEllipsizePropertyInfo), '("ellipsize-set", CellRendererTextEllipsizeSetPropertyInfo), '("family", CellRendererTextFamilyPropertyInfo), '("family-set", CellRendererTextFamilySetPropertyInfo), '("font", CellRendererTextFontPropertyInfo), '("font-desc", CellRendererTextFontDescPropertyInfo), '("foreground", CellRendererTextForegroundPropertyInfo), '("foreground-gdk", CellRendererTextForegroundGdkPropertyInfo), '("foreground-rgba", CellRendererTextForegroundRgbaPropertyInfo), '("foreground-set", CellRendererTextForegroundSetPropertyInfo), '("height", CellRendererHeightPropertyInfo), '("is-expanded", CellRendererIsExpandedPropertyInfo), '("is-expander", CellRendererIsExpanderPropertyInfo), '("language", CellRendererTextLanguagePropertyInfo), '("language-set", CellRendererTextLanguageSetPropertyInfo), '("markup", CellRendererTextMarkupPropertyInfo), '("max-width-chars", CellRendererTextMaxWidthCharsPropertyInfo), '("mode", CellRendererModePropertyInfo), '("placeholder-text", CellRendererTextPlaceholderTextPropertyInfo), '("rise", CellRendererTextRisePropertyInfo), '("rise-set", CellRendererTextRiseSetPropertyInfo), '("scale", CellRendererTextScalePropertyInfo), '("scale-set", CellRendererTextScaleSetPropertyInfo), '("sensitive", CellRendererSensitivePropertyInfo), '("single-paragraph-mode", CellRendererTextSingleParagraphModePropertyInfo), '("size", CellRendererTextSizePropertyInfo), '("size-points", CellRendererTextSizePointsPropertyInfo), '("size-set", CellRendererTextSizeSetPropertyInfo), '("stretch", CellRendererTextStretchPropertyInfo), '("stretch-set", CellRendererTextStretchSetPropertyInfo), '("strikethrough", CellRendererTextStrikethroughPropertyInfo), '("strikethrough-set", CellRendererTextStrikethroughSetPropertyInfo), '("style", CellRendererTextStylePropertyInfo), '("style-set", CellRendererTextStyleSetPropertyInfo), '("text", CellRendererTextTextPropertyInfo), '("underline", CellRendererTextUnderlinePropertyInfo), '("underline-set", CellRendererTextUnderlineSetPropertyInfo), '("variant", CellRendererTextVariantPropertyInfo), '("variant-set", CellRendererTextVariantSetPropertyInfo), '("visible", CellRendererVisiblePropertyInfo), '("weight", CellRendererTextWeightPropertyInfo), '("weight-set", CellRendererTextWeightSetPropertyInfo), '("width", CellRendererWidthPropertyInfo), '("width-chars", CellRendererTextWidthCharsPropertyInfo), '("wrap-mode", CellRendererTextWrapModePropertyInfo), '("wrap-width", CellRendererTextWrapWidthPropertyInfo), '("xalign", CellRendererXalignPropertyInfo), '("xpad", CellRendererXpadPropertyInfo), '("yalign", CellRendererYalignPropertyInfo), '("ypad", CellRendererYpadPropertyInfo)] -- VVV Prop "active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererSpinnerActive :: (MonadIO m, CellRendererSpinnerK o) => o -> m Bool getCellRendererSpinnerActive obj = liftIO $ getObjectPropertyBool obj "active" setCellRendererSpinnerActive :: (MonadIO m, CellRendererSpinnerK o) => o -> Bool -> m () setCellRendererSpinnerActive obj val = liftIO $ setObjectPropertyBool obj "active" val constructCellRendererSpinnerActive :: Bool -> IO ([Char], GValue) constructCellRendererSpinnerActive val = constructObjectPropertyBool "active" val data CellRendererSpinnerActivePropertyInfo instance AttrInfo CellRendererSpinnerActivePropertyInfo where type AttrAllowedOps CellRendererSpinnerActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererSpinnerActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererSpinnerActivePropertyInfo = CellRendererSpinnerK type AttrGetType CellRendererSpinnerActivePropertyInfo = Bool type AttrLabel CellRendererSpinnerActivePropertyInfo = "CellRendererSpinner::active" attrGet _ = getCellRendererSpinnerActive attrSet _ = setCellRendererSpinnerActive attrConstruct _ = constructCellRendererSpinnerActive -- VVV Prop "pulse" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererSpinnerPulse :: (MonadIO m, CellRendererSpinnerK o) => o -> m Word32 getCellRendererSpinnerPulse obj = liftIO $ getObjectPropertyCUInt obj "pulse" setCellRendererSpinnerPulse :: (MonadIO m, CellRendererSpinnerK o) => o -> Word32 -> m () setCellRendererSpinnerPulse obj val = liftIO $ setObjectPropertyCUInt obj "pulse" val constructCellRendererSpinnerPulse :: Word32 -> IO ([Char], GValue) constructCellRendererSpinnerPulse val = constructObjectPropertyCUInt "pulse" val data CellRendererSpinnerPulsePropertyInfo instance AttrInfo CellRendererSpinnerPulsePropertyInfo where type AttrAllowedOps CellRendererSpinnerPulsePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererSpinnerPulsePropertyInfo = (~) Word32 type AttrBaseTypeConstraint CellRendererSpinnerPulsePropertyInfo = CellRendererSpinnerK type AttrGetType CellRendererSpinnerPulsePropertyInfo = Word32 type AttrLabel CellRendererSpinnerPulsePropertyInfo = "CellRendererSpinner::pulse" attrGet _ = getCellRendererSpinnerPulse attrSet _ = setCellRendererSpinnerPulse attrConstruct _ = constructCellRendererSpinnerPulse -- VVV Prop "size" -- Type: TInterface "Gtk" "IconSize" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererSpinnerSize :: (MonadIO m, CellRendererSpinnerK o) => o -> m IconSize getCellRendererSpinnerSize obj = liftIO $ getObjectPropertyEnum obj "size" setCellRendererSpinnerSize :: (MonadIO m, CellRendererSpinnerK o) => o -> IconSize -> m () setCellRendererSpinnerSize obj val = liftIO $ setObjectPropertyEnum obj "size" val constructCellRendererSpinnerSize :: IconSize -> IO ([Char], GValue) constructCellRendererSpinnerSize val = constructObjectPropertyEnum "size" val data CellRendererSpinnerSizePropertyInfo instance AttrInfo CellRendererSpinnerSizePropertyInfo where type AttrAllowedOps CellRendererSpinnerSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererSpinnerSizePropertyInfo = (~) IconSize type AttrBaseTypeConstraint CellRendererSpinnerSizePropertyInfo = CellRendererSpinnerK type AttrGetType CellRendererSpinnerSizePropertyInfo = IconSize type AttrLabel CellRendererSpinnerSizePropertyInfo = "CellRendererSpinner::size" attrGet _ = getCellRendererSpinnerSize attrSet _ = setCellRendererSpinnerSize attrConstruct _ = constructCellRendererSpinnerSize type instance AttributeList CellRendererSpinner = '[ '("active", CellRendererSpinnerActivePropertyInfo), '("cell-background", CellRendererCellBackgroundPropertyInfo), '("cell-background-gdk", CellRendererCellBackgroundGdkPropertyInfo), '("cell-background-rgba", CellRendererCellBackgroundRgbaPropertyInfo), '("cell-background-set", CellRendererCellBackgroundSetPropertyInfo), '("editing", CellRendererEditingPropertyInfo), '("height", CellRendererHeightPropertyInfo), '("is-expanded", CellRendererIsExpandedPropertyInfo), '("is-expander", CellRendererIsExpanderPropertyInfo), '("mode", CellRendererModePropertyInfo), '("pulse", CellRendererSpinnerPulsePropertyInfo), '("sensitive", CellRendererSensitivePropertyInfo), '("size", CellRendererSpinnerSizePropertyInfo), '("visible", CellRendererVisiblePropertyInfo), '("width", CellRendererWidthPropertyInfo), '("xalign", CellRendererXalignPropertyInfo), '("xpad", CellRendererXpadPropertyInfo), '("yalign", CellRendererYalignPropertyInfo), '("ypad", CellRendererYpadPropertyInfo)] -- VVV Prop "align-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextAlignSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextAlignSet obj = liftIO $ getObjectPropertyBool obj "align-set" setCellRendererTextAlignSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextAlignSet obj val = liftIO $ setObjectPropertyBool obj "align-set" val constructCellRendererTextAlignSet :: Bool -> IO ([Char], GValue) constructCellRendererTextAlignSet val = constructObjectPropertyBool "align-set" val data CellRendererTextAlignSetPropertyInfo instance AttrInfo CellRendererTextAlignSetPropertyInfo where type AttrAllowedOps CellRendererTextAlignSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextAlignSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextAlignSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextAlignSetPropertyInfo = Bool type AttrLabel CellRendererTextAlignSetPropertyInfo = "CellRendererText::align-set" attrGet _ = getCellRendererTextAlignSet attrSet _ = setCellRendererTextAlignSet attrConstruct _ = constructCellRendererTextAlignSet -- VVV Prop "alignment" -- Type: TInterface "Pango" "Alignment" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextAlignment :: (MonadIO m, CellRendererTextK o) => o -> m Pango.Alignment getCellRendererTextAlignment obj = liftIO $ getObjectPropertyEnum obj "alignment" setCellRendererTextAlignment :: (MonadIO m, CellRendererTextK o) => o -> Pango.Alignment -> m () setCellRendererTextAlignment obj val = liftIO $ setObjectPropertyEnum obj "alignment" val constructCellRendererTextAlignment :: Pango.Alignment -> IO ([Char], GValue) constructCellRendererTextAlignment val = constructObjectPropertyEnum "alignment" val data CellRendererTextAlignmentPropertyInfo instance AttrInfo CellRendererTextAlignmentPropertyInfo where type AttrAllowedOps CellRendererTextAlignmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextAlignmentPropertyInfo = (~) Pango.Alignment type AttrBaseTypeConstraint CellRendererTextAlignmentPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextAlignmentPropertyInfo = Pango.Alignment type AttrLabel CellRendererTextAlignmentPropertyInfo = "CellRendererText::alignment" attrGet _ = getCellRendererTextAlignment attrSet _ = setCellRendererTextAlignment attrConstruct _ = constructCellRendererTextAlignment -- VVV Prop "attributes" -- Type: TInterface "Pango" "AttrList" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextAttributes :: (MonadIO m, CellRendererTextK o) => o -> m Pango.AttrList getCellRendererTextAttributes obj = liftIO $ getObjectPropertyBoxed obj "attributes" Pango.AttrList setCellRendererTextAttributes :: (MonadIO m, CellRendererTextK o) => o -> Pango.AttrList -> m () setCellRendererTextAttributes obj val = liftIO $ setObjectPropertyBoxed obj "attributes" val constructCellRendererTextAttributes :: Pango.AttrList -> IO ([Char], GValue) constructCellRendererTextAttributes val = constructObjectPropertyBoxed "attributes" val data CellRendererTextAttributesPropertyInfo instance AttrInfo CellRendererTextAttributesPropertyInfo where type AttrAllowedOps CellRendererTextAttributesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextAttributesPropertyInfo = (~) Pango.AttrList type AttrBaseTypeConstraint CellRendererTextAttributesPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextAttributesPropertyInfo = Pango.AttrList type AttrLabel CellRendererTextAttributesPropertyInfo = "CellRendererText::attributes" attrGet _ = getCellRendererTextAttributes attrSet _ = setCellRendererTextAttributes attrConstruct _ = constructCellRendererTextAttributes -- VVV Prop "background" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setCellRendererTextBackground :: (MonadIO m, CellRendererTextK o) => o -> T.Text -> m () setCellRendererTextBackground obj val = liftIO $ setObjectPropertyString obj "background" val constructCellRendererTextBackground :: T.Text -> IO ([Char], GValue) constructCellRendererTextBackground val = constructObjectPropertyString "background" val data CellRendererTextBackgroundPropertyInfo instance AttrInfo CellRendererTextBackgroundPropertyInfo where type AttrAllowedOps CellRendererTextBackgroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint CellRendererTextBackgroundPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererTextBackgroundPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextBackgroundPropertyInfo = () type AttrLabel CellRendererTextBackgroundPropertyInfo = "CellRendererText::background" attrGet _ = undefined attrSet _ = setCellRendererTextBackground attrConstruct _ = constructCellRendererTextBackground -- VVV Prop "background-gdk" -- Type: TInterface "Gdk" "Color" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextBackgroundGdk :: (MonadIO m, CellRendererTextK o) => o -> m Gdk.Color getCellRendererTextBackgroundGdk obj = liftIO $ getObjectPropertyBoxed obj "background-gdk" Gdk.Color setCellRendererTextBackgroundGdk :: (MonadIO m, CellRendererTextK o) => o -> Gdk.Color -> m () setCellRendererTextBackgroundGdk obj val = liftIO $ setObjectPropertyBoxed obj "background-gdk" val constructCellRendererTextBackgroundGdk :: Gdk.Color -> IO ([Char], GValue) constructCellRendererTextBackgroundGdk val = constructObjectPropertyBoxed "background-gdk" val data CellRendererTextBackgroundGdkPropertyInfo instance AttrInfo CellRendererTextBackgroundGdkPropertyInfo where type AttrAllowedOps CellRendererTextBackgroundGdkPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextBackgroundGdkPropertyInfo = (~) Gdk.Color type AttrBaseTypeConstraint CellRendererTextBackgroundGdkPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextBackgroundGdkPropertyInfo = Gdk.Color type AttrLabel CellRendererTextBackgroundGdkPropertyInfo = "CellRendererText::background-gdk" attrGet _ = getCellRendererTextBackgroundGdk attrSet _ = setCellRendererTextBackgroundGdk attrConstruct _ = constructCellRendererTextBackgroundGdk -- VVV Prop "background-rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextBackgroundRgba :: (MonadIO m, CellRendererTextK o) => o -> m Gdk.RGBA getCellRendererTextBackgroundRgba obj = liftIO $ getObjectPropertyBoxed obj "background-rgba" Gdk.RGBA setCellRendererTextBackgroundRgba :: (MonadIO m, CellRendererTextK o) => o -> Gdk.RGBA -> m () setCellRendererTextBackgroundRgba obj val = liftIO $ setObjectPropertyBoxed obj "background-rgba" val constructCellRendererTextBackgroundRgba :: Gdk.RGBA -> IO ([Char], GValue) constructCellRendererTextBackgroundRgba val = constructObjectPropertyBoxed "background-rgba" val data CellRendererTextBackgroundRgbaPropertyInfo instance AttrInfo CellRendererTextBackgroundRgbaPropertyInfo where type AttrAllowedOps CellRendererTextBackgroundRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextBackgroundRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint CellRendererTextBackgroundRgbaPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextBackgroundRgbaPropertyInfo = Gdk.RGBA type AttrLabel CellRendererTextBackgroundRgbaPropertyInfo = "CellRendererText::background-rgba" attrGet _ = getCellRendererTextBackgroundRgba attrSet _ = setCellRendererTextBackgroundRgba attrConstruct _ = constructCellRendererTextBackgroundRgba -- VVV Prop "background-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextBackgroundSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextBackgroundSet obj = liftIO $ getObjectPropertyBool obj "background-set" setCellRendererTextBackgroundSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextBackgroundSet obj val = liftIO $ setObjectPropertyBool obj "background-set" val constructCellRendererTextBackgroundSet :: Bool -> IO ([Char], GValue) constructCellRendererTextBackgroundSet val = constructObjectPropertyBool "background-set" val data CellRendererTextBackgroundSetPropertyInfo instance AttrInfo CellRendererTextBackgroundSetPropertyInfo where type AttrAllowedOps CellRendererTextBackgroundSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextBackgroundSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextBackgroundSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextBackgroundSetPropertyInfo = Bool type AttrLabel CellRendererTextBackgroundSetPropertyInfo = "CellRendererText::background-set" attrGet _ = getCellRendererTextBackgroundSet attrSet _ = setCellRendererTextBackgroundSet attrConstruct _ = constructCellRendererTextBackgroundSet -- VVV Prop "editable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextEditable :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextEditable obj = liftIO $ getObjectPropertyBool obj "editable" setCellRendererTextEditable :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextEditable obj val = liftIO $ setObjectPropertyBool obj "editable" val constructCellRendererTextEditable :: Bool -> IO ([Char], GValue) constructCellRendererTextEditable val = constructObjectPropertyBool "editable" val data CellRendererTextEditablePropertyInfo instance AttrInfo CellRendererTextEditablePropertyInfo where type AttrAllowedOps CellRendererTextEditablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextEditablePropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextEditablePropertyInfo = CellRendererTextK type AttrGetType CellRendererTextEditablePropertyInfo = Bool type AttrLabel CellRendererTextEditablePropertyInfo = "CellRendererText::editable" attrGet _ = getCellRendererTextEditable attrSet _ = setCellRendererTextEditable attrConstruct _ = constructCellRendererTextEditable -- VVV Prop "editable-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextEditableSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextEditableSet obj = liftIO $ getObjectPropertyBool obj "editable-set" setCellRendererTextEditableSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextEditableSet obj val = liftIO $ setObjectPropertyBool obj "editable-set" val constructCellRendererTextEditableSet :: Bool -> IO ([Char], GValue) constructCellRendererTextEditableSet val = constructObjectPropertyBool "editable-set" val data CellRendererTextEditableSetPropertyInfo instance AttrInfo CellRendererTextEditableSetPropertyInfo where type AttrAllowedOps CellRendererTextEditableSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextEditableSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextEditableSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextEditableSetPropertyInfo = Bool type AttrLabel CellRendererTextEditableSetPropertyInfo = "CellRendererText::editable-set" attrGet _ = getCellRendererTextEditableSet attrSet _ = setCellRendererTextEditableSet attrConstruct _ = constructCellRendererTextEditableSet -- VVV Prop "ellipsize" -- Type: TInterface "Pango" "EllipsizeMode" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextEllipsize :: (MonadIO m, CellRendererTextK o) => o -> m Pango.EllipsizeMode getCellRendererTextEllipsize obj = liftIO $ getObjectPropertyEnum obj "ellipsize" setCellRendererTextEllipsize :: (MonadIO m, CellRendererTextK o) => o -> Pango.EllipsizeMode -> m () setCellRendererTextEllipsize obj val = liftIO $ setObjectPropertyEnum obj "ellipsize" val constructCellRendererTextEllipsize :: Pango.EllipsizeMode -> IO ([Char], GValue) constructCellRendererTextEllipsize val = constructObjectPropertyEnum "ellipsize" val data CellRendererTextEllipsizePropertyInfo instance AttrInfo CellRendererTextEllipsizePropertyInfo where type AttrAllowedOps CellRendererTextEllipsizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextEllipsizePropertyInfo = (~) Pango.EllipsizeMode type AttrBaseTypeConstraint CellRendererTextEllipsizePropertyInfo = CellRendererTextK type AttrGetType CellRendererTextEllipsizePropertyInfo = Pango.EllipsizeMode type AttrLabel CellRendererTextEllipsizePropertyInfo = "CellRendererText::ellipsize" attrGet _ = getCellRendererTextEllipsize attrSet _ = setCellRendererTextEllipsize attrConstruct _ = constructCellRendererTextEllipsize -- VVV Prop "ellipsize-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextEllipsizeSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextEllipsizeSet obj = liftIO $ getObjectPropertyBool obj "ellipsize-set" setCellRendererTextEllipsizeSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextEllipsizeSet obj val = liftIO $ setObjectPropertyBool obj "ellipsize-set" val constructCellRendererTextEllipsizeSet :: Bool -> IO ([Char], GValue) constructCellRendererTextEllipsizeSet val = constructObjectPropertyBool "ellipsize-set" val data CellRendererTextEllipsizeSetPropertyInfo instance AttrInfo CellRendererTextEllipsizeSetPropertyInfo where type AttrAllowedOps CellRendererTextEllipsizeSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextEllipsizeSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextEllipsizeSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextEllipsizeSetPropertyInfo = Bool type AttrLabel CellRendererTextEllipsizeSetPropertyInfo = "CellRendererText::ellipsize-set" attrGet _ = getCellRendererTextEllipsizeSet attrSet _ = setCellRendererTextEllipsizeSet attrConstruct _ = constructCellRendererTextEllipsizeSet -- VVV Prop "family" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextFamily :: (MonadIO m, CellRendererTextK o) => o -> m T.Text getCellRendererTextFamily obj = liftIO $ getObjectPropertyString obj "family" setCellRendererTextFamily :: (MonadIO m, CellRendererTextK o) => o -> T.Text -> m () setCellRendererTextFamily obj val = liftIO $ setObjectPropertyString obj "family" val constructCellRendererTextFamily :: T.Text -> IO ([Char], GValue) constructCellRendererTextFamily val = constructObjectPropertyString "family" val data CellRendererTextFamilyPropertyInfo instance AttrInfo CellRendererTextFamilyPropertyInfo where type AttrAllowedOps CellRendererTextFamilyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextFamilyPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererTextFamilyPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextFamilyPropertyInfo = T.Text type AttrLabel CellRendererTextFamilyPropertyInfo = "CellRendererText::family" attrGet _ = getCellRendererTextFamily attrSet _ = setCellRendererTextFamily attrConstruct _ = constructCellRendererTextFamily -- VVV Prop "family-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextFamilySet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextFamilySet obj = liftIO $ getObjectPropertyBool obj "family-set" setCellRendererTextFamilySet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextFamilySet obj val = liftIO $ setObjectPropertyBool obj "family-set" val constructCellRendererTextFamilySet :: Bool -> IO ([Char], GValue) constructCellRendererTextFamilySet val = constructObjectPropertyBool "family-set" val data CellRendererTextFamilySetPropertyInfo instance AttrInfo CellRendererTextFamilySetPropertyInfo where type AttrAllowedOps CellRendererTextFamilySetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextFamilySetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextFamilySetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextFamilySetPropertyInfo = Bool type AttrLabel CellRendererTextFamilySetPropertyInfo = "CellRendererText::family-set" attrGet _ = getCellRendererTextFamilySet attrSet _ = setCellRendererTextFamilySet attrConstruct _ = constructCellRendererTextFamilySet -- VVV Prop "font" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextFont :: (MonadIO m, CellRendererTextK o) => o -> m T.Text getCellRendererTextFont obj = liftIO $ getObjectPropertyString obj "font" setCellRendererTextFont :: (MonadIO m, CellRendererTextK o) => o -> T.Text -> m () setCellRendererTextFont obj val = liftIO $ setObjectPropertyString obj "font" val constructCellRendererTextFont :: T.Text -> IO ([Char], GValue) constructCellRendererTextFont val = constructObjectPropertyString "font" val data CellRendererTextFontPropertyInfo instance AttrInfo CellRendererTextFontPropertyInfo where type AttrAllowedOps CellRendererTextFontPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextFontPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererTextFontPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextFontPropertyInfo = T.Text type AttrLabel CellRendererTextFontPropertyInfo = "CellRendererText::font" attrGet _ = getCellRendererTextFont attrSet _ = setCellRendererTextFont attrConstruct _ = constructCellRendererTextFont -- VVV Prop "font-desc" -- Type: TInterface "Pango" "FontDescription" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextFontDesc :: (MonadIO m, CellRendererTextK o) => o -> m Pango.FontDescription getCellRendererTextFontDesc obj = liftIO $ getObjectPropertyBoxed obj "font-desc" Pango.FontDescription setCellRendererTextFontDesc :: (MonadIO m, CellRendererTextK o) => o -> Pango.FontDescription -> m () setCellRendererTextFontDesc obj val = liftIO $ setObjectPropertyBoxed obj "font-desc" val constructCellRendererTextFontDesc :: Pango.FontDescription -> IO ([Char], GValue) constructCellRendererTextFontDesc val = constructObjectPropertyBoxed "font-desc" val data CellRendererTextFontDescPropertyInfo instance AttrInfo CellRendererTextFontDescPropertyInfo where type AttrAllowedOps CellRendererTextFontDescPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextFontDescPropertyInfo = (~) Pango.FontDescription type AttrBaseTypeConstraint CellRendererTextFontDescPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextFontDescPropertyInfo = Pango.FontDescription type AttrLabel CellRendererTextFontDescPropertyInfo = "CellRendererText::font-desc" attrGet _ = getCellRendererTextFontDesc attrSet _ = setCellRendererTextFontDesc attrConstruct _ = constructCellRendererTextFontDesc -- VVV Prop "foreground" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setCellRendererTextForeground :: (MonadIO m, CellRendererTextK o) => o -> T.Text -> m () setCellRendererTextForeground obj val = liftIO $ setObjectPropertyString obj "foreground" val constructCellRendererTextForeground :: T.Text -> IO ([Char], GValue) constructCellRendererTextForeground val = constructObjectPropertyString "foreground" val data CellRendererTextForegroundPropertyInfo instance AttrInfo CellRendererTextForegroundPropertyInfo where type AttrAllowedOps CellRendererTextForegroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint CellRendererTextForegroundPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererTextForegroundPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextForegroundPropertyInfo = () type AttrLabel CellRendererTextForegroundPropertyInfo = "CellRendererText::foreground" attrGet _ = undefined attrSet _ = setCellRendererTextForeground attrConstruct _ = constructCellRendererTextForeground -- VVV Prop "foreground-gdk" -- Type: TInterface "Gdk" "Color" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextForegroundGdk :: (MonadIO m, CellRendererTextK o) => o -> m Gdk.Color getCellRendererTextForegroundGdk obj = liftIO $ getObjectPropertyBoxed obj "foreground-gdk" Gdk.Color setCellRendererTextForegroundGdk :: (MonadIO m, CellRendererTextK o) => o -> Gdk.Color -> m () setCellRendererTextForegroundGdk obj val = liftIO $ setObjectPropertyBoxed obj "foreground-gdk" val constructCellRendererTextForegroundGdk :: Gdk.Color -> IO ([Char], GValue) constructCellRendererTextForegroundGdk val = constructObjectPropertyBoxed "foreground-gdk" val data CellRendererTextForegroundGdkPropertyInfo instance AttrInfo CellRendererTextForegroundGdkPropertyInfo where type AttrAllowedOps CellRendererTextForegroundGdkPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextForegroundGdkPropertyInfo = (~) Gdk.Color type AttrBaseTypeConstraint CellRendererTextForegroundGdkPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextForegroundGdkPropertyInfo = Gdk.Color type AttrLabel CellRendererTextForegroundGdkPropertyInfo = "CellRendererText::foreground-gdk" attrGet _ = getCellRendererTextForegroundGdk attrSet _ = setCellRendererTextForegroundGdk attrConstruct _ = constructCellRendererTextForegroundGdk -- VVV Prop "foreground-rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextForegroundRgba :: (MonadIO m, CellRendererTextK o) => o -> m Gdk.RGBA getCellRendererTextForegroundRgba obj = liftIO $ getObjectPropertyBoxed obj "foreground-rgba" Gdk.RGBA setCellRendererTextForegroundRgba :: (MonadIO m, CellRendererTextK o) => o -> Gdk.RGBA -> m () setCellRendererTextForegroundRgba obj val = liftIO $ setObjectPropertyBoxed obj "foreground-rgba" val constructCellRendererTextForegroundRgba :: Gdk.RGBA -> IO ([Char], GValue) constructCellRendererTextForegroundRgba val = constructObjectPropertyBoxed "foreground-rgba" val data CellRendererTextForegroundRgbaPropertyInfo instance AttrInfo CellRendererTextForegroundRgbaPropertyInfo where type AttrAllowedOps CellRendererTextForegroundRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextForegroundRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint CellRendererTextForegroundRgbaPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextForegroundRgbaPropertyInfo = Gdk.RGBA type AttrLabel CellRendererTextForegroundRgbaPropertyInfo = "CellRendererText::foreground-rgba" attrGet _ = getCellRendererTextForegroundRgba attrSet _ = setCellRendererTextForegroundRgba attrConstruct _ = constructCellRendererTextForegroundRgba -- VVV Prop "foreground-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextForegroundSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextForegroundSet obj = liftIO $ getObjectPropertyBool obj "foreground-set" setCellRendererTextForegroundSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextForegroundSet obj val = liftIO $ setObjectPropertyBool obj "foreground-set" val constructCellRendererTextForegroundSet :: Bool -> IO ([Char], GValue) constructCellRendererTextForegroundSet val = constructObjectPropertyBool "foreground-set" val data CellRendererTextForegroundSetPropertyInfo instance AttrInfo CellRendererTextForegroundSetPropertyInfo where type AttrAllowedOps CellRendererTextForegroundSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextForegroundSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextForegroundSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextForegroundSetPropertyInfo = Bool type AttrLabel CellRendererTextForegroundSetPropertyInfo = "CellRendererText::foreground-set" attrGet _ = getCellRendererTextForegroundSet attrSet _ = setCellRendererTextForegroundSet attrConstruct _ = constructCellRendererTextForegroundSet -- VVV Prop "language" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextLanguage :: (MonadIO m, CellRendererTextK o) => o -> m T.Text getCellRendererTextLanguage obj = liftIO $ getObjectPropertyString obj "language" setCellRendererTextLanguage :: (MonadIO m, CellRendererTextK o) => o -> T.Text -> m () setCellRendererTextLanguage obj val = liftIO $ setObjectPropertyString obj "language" val constructCellRendererTextLanguage :: T.Text -> IO ([Char], GValue) constructCellRendererTextLanguage val = constructObjectPropertyString "language" val data CellRendererTextLanguagePropertyInfo instance AttrInfo CellRendererTextLanguagePropertyInfo where type AttrAllowedOps CellRendererTextLanguagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextLanguagePropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererTextLanguagePropertyInfo = CellRendererTextK type AttrGetType CellRendererTextLanguagePropertyInfo = T.Text type AttrLabel CellRendererTextLanguagePropertyInfo = "CellRendererText::language" attrGet _ = getCellRendererTextLanguage attrSet _ = setCellRendererTextLanguage attrConstruct _ = constructCellRendererTextLanguage -- VVV Prop "language-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextLanguageSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextLanguageSet obj = liftIO $ getObjectPropertyBool obj "language-set" setCellRendererTextLanguageSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextLanguageSet obj val = liftIO $ setObjectPropertyBool obj "language-set" val constructCellRendererTextLanguageSet :: Bool -> IO ([Char], GValue) constructCellRendererTextLanguageSet val = constructObjectPropertyBool "language-set" val data CellRendererTextLanguageSetPropertyInfo instance AttrInfo CellRendererTextLanguageSetPropertyInfo where type AttrAllowedOps CellRendererTextLanguageSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextLanguageSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextLanguageSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextLanguageSetPropertyInfo = Bool type AttrLabel CellRendererTextLanguageSetPropertyInfo = "CellRendererText::language-set" attrGet _ = getCellRendererTextLanguageSet attrSet _ = setCellRendererTextLanguageSet attrConstruct _ = constructCellRendererTextLanguageSet -- VVV Prop "markup" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setCellRendererTextMarkup :: (MonadIO m, CellRendererTextK o) => o -> T.Text -> m () setCellRendererTextMarkup obj val = liftIO $ setObjectPropertyString obj "markup" val constructCellRendererTextMarkup :: T.Text -> IO ([Char], GValue) constructCellRendererTextMarkup val = constructObjectPropertyString "markup" val data CellRendererTextMarkupPropertyInfo instance AttrInfo CellRendererTextMarkupPropertyInfo where type AttrAllowedOps CellRendererTextMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint CellRendererTextMarkupPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererTextMarkupPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextMarkupPropertyInfo = () type AttrLabel CellRendererTextMarkupPropertyInfo = "CellRendererText::markup" attrGet _ = undefined attrSet _ = setCellRendererTextMarkup attrConstruct _ = constructCellRendererTextMarkup -- VVV Prop "max-width-chars" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextMaxWidthChars :: (MonadIO m, CellRendererTextK o) => o -> m Int32 getCellRendererTextMaxWidthChars obj = liftIO $ getObjectPropertyCInt obj "max-width-chars" setCellRendererTextMaxWidthChars :: (MonadIO m, CellRendererTextK o) => o -> Int32 -> m () setCellRendererTextMaxWidthChars obj val = liftIO $ setObjectPropertyCInt obj "max-width-chars" val constructCellRendererTextMaxWidthChars :: Int32 -> IO ([Char], GValue) constructCellRendererTextMaxWidthChars val = constructObjectPropertyCInt "max-width-chars" val data CellRendererTextMaxWidthCharsPropertyInfo instance AttrInfo CellRendererTextMaxWidthCharsPropertyInfo where type AttrAllowedOps CellRendererTextMaxWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextMaxWidthCharsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererTextMaxWidthCharsPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextMaxWidthCharsPropertyInfo = Int32 type AttrLabel CellRendererTextMaxWidthCharsPropertyInfo = "CellRendererText::max-width-chars" attrGet _ = getCellRendererTextMaxWidthChars attrSet _ = setCellRendererTextMaxWidthChars attrConstruct _ = constructCellRendererTextMaxWidthChars -- VVV Prop "placeholder-text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextPlaceholderText :: (MonadIO m, CellRendererTextK o) => o -> m T.Text getCellRendererTextPlaceholderText obj = liftIO $ getObjectPropertyString obj "placeholder-text" setCellRendererTextPlaceholderText :: (MonadIO m, CellRendererTextK o) => o -> T.Text -> m () setCellRendererTextPlaceholderText obj val = liftIO $ setObjectPropertyString obj "placeholder-text" val constructCellRendererTextPlaceholderText :: T.Text -> IO ([Char], GValue) constructCellRendererTextPlaceholderText val = constructObjectPropertyString "placeholder-text" val data CellRendererTextPlaceholderTextPropertyInfo instance AttrInfo CellRendererTextPlaceholderTextPropertyInfo where type AttrAllowedOps CellRendererTextPlaceholderTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextPlaceholderTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererTextPlaceholderTextPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextPlaceholderTextPropertyInfo = T.Text type AttrLabel CellRendererTextPlaceholderTextPropertyInfo = "CellRendererText::placeholder-text" attrGet _ = getCellRendererTextPlaceholderText attrSet _ = setCellRendererTextPlaceholderText attrConstruct _ = constructCellRendererTextPlaceholderText -- VVV Prop "rise" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextRise :: (MonadIO m, CellRendererTextK o) => o -> m Int32 getCellRendererTextRise obj = liftIO $ getObjectPropertyCInt obj "rise" setCellRendererTextRise :: (MonadIO m, CellRendererTextK o) => o -> Int32 -> m () setCellRendererTextRise obj val = liftIO $ setObjectPropertyCInt obj "rise" val constructCellRendererTextRise :: Int32 -> IO ([Char], GValue) constructCellRendererTextRise val = constructObjectPropertyCInt "rise" val data CellRendererTextRisePropertyInfo instance AttrInfo CellRendererTextRisePropertyInfo where type AttrAllowedOps CellRendererTextRisePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextRisePropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererTextRisePropertyInfo = CellRendererTextK type AttrGetType CellRendererTextRisePropertyInfo = Int32 type AttrLabel CellRendererTextRisePropertyInfo = "CellRendererText::rise" attrGet _ = getCellRendererTextRise attrSet _ = setCellRendererTextRise attrConstruct _ = constructCellRendererTextRise -- VVV Prop "rise-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextRiseSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextRiseSet obj = liftIO $ getObjectPropertyBool obj "rise-set" setCellRendererTextRiseSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextRiseSet obj val = liftIO $ setObjectPropertyBool obj "rise-set" val constructCellRendererTextRiseSet :: Bool -> IO ([Char], GValue) constructCellRendererTextRiseSet val = constructObjectPropertyBool "rise-set" val data CellRendererTextRiseSetPropertyInfo instance AttrInfo CellRendererTextRiseSetPropertyInfo where type AttrAllowedOps CellRendererTextRiseSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextRiseSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextRiseSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextRiseSetPropertyInfo = Bool type AttrLabel CellRendererTextRiseSetPropertyInfo = "CellRendererText::rise-set" attrGet _ = getCellRendererTextRiseSet attrSet _ = setCellRendererTextRiseSet attrConstruct _ = constructCellRendererTextRiseSet -- VVV Prop "scale" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextScale :: (MonadIO m, CellRendererTextK o) => o -> m Double getCellRendererTextScale obj = liftIO $ getObjectPropertyDouble obj "scale" setCellRendererTextScale :: (MonadIO m, CellRendererTextK o) => o -> Double -> m () setCellRendererTextScale obj val = liftIO $ setObjectPropertyDouble obj "scale" val constructCellRendererTextScale :: Double -> IO ([Char], GValue) constructCellRendererTextScale val = constructObjectPropertyDouble "scale" val data CellRendererTextScalePropertyInfo instance AttrInfo CellRendererTextScalePropertyInfo where type AttrAllowedOps CellRendererTextScalePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextScalePropertyInfo = (~) Double type AttrBaseTypeConstraint CellRendererTextScalePropertyInfo = CellRendererTextK type AttrGetType CellRendererTextScalePropertyInfo = Double type AttrLabel CellRendererTextScalePropertyInfo = "CellRendererText::scale" attrGet _ = getCellRendererTextScale attrSet _ = setCellRendererTextScale attrConstruct _ = constructCellRendererTextScale -- VVV Prop "scale-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextScaleSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextScaleSet obj = liftIO $ getObjectPropertyBool obj "scale-set" setCellRendererTextScaleSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextScaleSet obj val = liftIO $ setObjectPropertyBool obj "scale-set" val constructCellRendererTextScaleSet :: Bool -> IO ([Char], GValue) constructCellRendererTextScaleSet val = constructObjectPropertyBool "scale-set" val data CellRendererTextScaleSetPropertyInfo instance AttrInfo CellRendererTextScaleSetPropertyInfo where type AttrAllowedOps CellRendererTextScaleSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextScaleSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextScaleSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextScaleSetPropertyInfo = Bool type AttrLabel CellRendererTextScaleSetPropertyInfo = "CellRendererText::scale-set" attrGet _ = getCellRendererTextScaleSet attrSet _ = setCellRendererTextScaleSet attrConstruct _ = constructCellRendererTextScaleSet -- VVV Prop "single-paragraph-mode" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextSingleParagraphMode :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextSingleParagraphMode obj = liftIO $ getObjectPropertyBool obj "single-paragraph-mode" setCellRendererTextSingleParagraphMode :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextSingleParagraphMode obj val = liftIO $ setObjectPropertyBool obj "single-paragraph-mode" val constructCellRendererTextSingleParagraphMode :: Bool -> IO ([Char], GValue) constructCellRendererTextSingleParagraphMode val = constructObjectPropertyBool "single-paragraph-mode" val data CellRendererTextSingleParagraphModePropertyInfo instance AttrInfo CellRendererTextSingleParagraphModePropertyInfo where type AttrAllowedOps CellRendererTextSingleParagraphModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextSingleParagraphModePropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextSingleParagraphModePropertyInfo = CellRendererTextK type AttrGetType CellRendererTextSingleParagraphModePropertyInfo = Bool type AttrLabel CellRendererTextSingleParagraphModePropertyInfo = "CellRendererText::single-paragraph-mode" attrGet _ = getCellRendererTextSingleParagraphMode attrSet _ = setCellRendererTextSingleParagraphMode attrConstruct _ = constructCellRendererTextSingleParagraphMode -- VVV Prop "size" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextSize :: (MonadIO m, CellRendererTextK o) => o -> m Int32 getCellRendererTextSize obj = liftIO $ getObjectPropertyCInt obj "size" setCellRendererTextSize :: (MonadIO m, CellRendererTextK o) => o -> Int32 -> m () setCellRendererTextSize obj val = liftIO $ setObjectPropertyCInt obj "size" val constructCellRendererTextSize :: Int32 -> IO ([Char], GValue) constructCellRendererTextSize val = constructObjectPropertyCInt "size" val data CellRendererTextSizePropertyInfo instance AttrInfo CellRendererTextSizePropertyInfo where type AttrAllowedOps CellRendererTextSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextSizePropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererTextSizePropertyInfo = CellRendererTextK type AttrGetType CellRendererTextSizePropertyInfo = Int32 type AttrLabel CellRendererTextSizePropertyInfo = "CellRendererText::size" attrGet _ = getCellRendererTextSize attrSet _ = setCellRendererTextSize attrConstruct _ = constructCellRendererTextSize -- VVV Prop "size-points" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextSizePoints :: (MonadIO m, CellRendererTextK o) => o -> m Double getCellRendererTextSizePoints obj = liftIO $ getObjectPropertyDouble obj "size-points" setCellRendererTextSizePoints :: (MonadIO m, CellRendererTextK o) => o -> Double -> m () setCellRendererTextSizePoints obj val = liftIO $ setObjectPropertyDouble obj "size-points" val constructCellRendererTextSizePoints :: Double -> IO ([Char], GValue) constructCellRendererTextSizePoints val = constructObjectPropertyDouble "size-points" val data CellRendererTextSizePointsPropertyInfo instance AttrInfo CellRendererTextSizePointsPropertyInfo where type AttrAllowedOps CellRendererTextSizePointsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextSizePointsPropertyInfo = (~) Double type AttrBaseTypeConstraint CellRendererTextSizePointsPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextSizePointsPropertyInfo = Double type AttrLabel CellRendererTextSizePointsPropertyInfo = "CellRendererText::size-points" attrGet _ = getCellRendererTextSizePoints attrSet _ = setCellRendererTextSizePoints attrConstruct _ = constructCellRendererTextSizePoints -- VVV Prop "size-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextSizeSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextSizeSet obj = liftIO $ getObjectPropertyBool obj "size-set" setCellRendererTextSizeSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextSizeSet obj val = liftIO $ setObjectPropertyBool obj "size-set" val constructCellRendererTextSizeSet :: Bool -> IO ([Char], GValue) constructCellRendererTextSizeSet val = constructObjectPropertyBool "size-set" val data CellRendererTextSizeSetPropertyInfo instance AttrInfo CellRendererTextSizeSetPropertyInfo where type AttrAllowedOps CellRendererTextSizeSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextSizeSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextSizeSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextSizeSetPropertyInfo = Bool type AttrLabel CellRendererTextSizeSetPropertyInfo = "CellRendererText::size-set" attrGet _ = getCellRendererTextSizeSet attrSet _ = setCellRendererTextSizeSet attrConstruct _ = constructCellRendererTextSizeSet -- VVV Prop "stretch" -- Type: TInterface "Pango" "Stretch" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextStretch :: (MonadIO m, CellRendererTextK o) => o -> m Pango.Stretch getCellRendererTextStretch obj = liftIO $ getObjectPropertyEnum obj "stretch" setCellRendererTextStretch :: (MonadIO m, CellRendererTextK o) => o -> Pango.Stretch -> m () setCellRendererTextStretch obj val = liftIO $ setObjectPropertyEnum obj "stretch" val constructCellRendererTextStretch :: Pango.Stretch -> IO ([Char], GValue) constructCellRendererTextStretch val = constructObjectPropertyEnum "stretch" val data CellRendererTextStretchPropertyInfo instance AttrInfo CellRendererTextStretchPropertyInfo where type AttrAllowedOps CellRendererTextStretchPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextStretchPropertyInfo = (~) Pango.Stretch type AttrBaseTypeConstraint CellRendererTextStretchPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextStretchPropertyInfo = Pango.Stretch type AttrLabel CellRendererTextStretchPropertyInfo = "CellRendererText::stretch" attrGet _ = getCellRendererTextStretch attrSet _ = setCellRendererTextStretch attrConstruct _ = constructCellRendererTextStretch -- VVV Prop "stretch-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextStretchSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextStretchSet obj = liftIO $ getObjectPropertyBool obj "stretch-set" setCellRendererTextStretchSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextStretchSet obj val = liftIO $ setObjectPropertyBool obj "stretch-set" val constructCellRendererTextStretchSet :: Bool -> IO ([Char], GValue) constructCellRendererTextStretchSet val = constructObjectPropertyBool "stretch-set" val data CellRendererTextStretchSetPropertyInfo instance AttrInfo CellRendererTextStretchSetPropertyInfo where type AttrAllowedOps CellRendererTextStretchSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextStretchSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextStretchSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextStretchSetPropertyInfo = Bool type AttrLabel CellRendererTextStretchSetPropertyInfo = "CellRendererText::stretch-set" attrGet _ = getCellRendererTextStretchSet attrSet _ = setCellRendererTextStretchSet attrConstruct _ = constructCellRendererTextStretchSet -- VVV Prop "strikethrough" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextStrikethrough :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextStrikethrough obj = liftIO $ getObjectPropertyBool obj "strikethrough" setCellRendererTextStrikethrough :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextStrikethrough obj val = liftIO $ setObjectPropertyBool obj "strikethrough" val constructCellRendererTextStrikethrough :: Bool -> IO ([Char], GValue) constructCellRendererTextStrikethrough val = constructObjectPropertyBool "strikethrough" val data CellRendererTextStrikethroughPropertyInfo instance AttrInfo CellRendererTextStrikethroughPropertyInfo where type AttrAllowedOps CellRendererTextStrikethroughPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextStrikethroughPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextStrikethroughPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextStrikethroughPropertyInfo = Bool type AttrLabel CellRendererTextStrikethroughPropertyInfo = "CellRendererText::strikethrough" attrGet _ = getCellRendererTextStrikethrough attrSet _ = setCellRendererTextStrikethrough attrConstruct _ = constructCellRendererTextStrikethrough -- VVV Prop "strikethrough-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextStrikethroughSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextStrikethroughSet obj = liftIO $ getObjectPropertyBool obj "strikethrough-set" setCellRendererTextStrikethroughSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextStrikethroughSet obj val = liftIO $ setObjectPropertyBool obj "strikethrough-set" val constructCellRendererTextStrikethroughSet :: Bool -> IO ([Char], GValue) constructCellRendererTextStrikethroughSet val = constructObjectPropertyBool "strikethrough-set" val data CellRendererTextStrikethroughSetPropertyInfo instance AttrInfo CellRendererTextStrikethroughSetPropertyInfo where type AttrAllowedOps CellRendererTextStrikethroughSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextStrikethroughSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextStrikethroughSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextStrikethroughSetPropertyInfo = Bool type AttrLabel CellRendererTextStrikethroughSetPropertyInfo = "CellRendererText::strikethrough-set" attrGet _ = getCellRendererTextStrikethroughSet attrSet _ = setCellRendererTextStrikethroughSet attrConstruct _ = constructCellRendererTextStrikethroughSet -- VVV Prop "style" -- Type: TInterface "Pango" "Style" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextStyle :: (MonadIO m, CellRendererTextK o) => o -> m Pango.Style getCellRendererTextStyle obj = liftIO $ getObjectPropertyEnum obj "style" setCellRendererTextStyle :: (MonadIO m, CellRendererTextK o) => o -> Pango.Style -> m () setCellRendererTextStyle obj val = liftIO $ setObjectPropertyEnum obj "style" val constructCellRendererTextStyle :: Pango.Style -> IO ([Char], GValue) constructCellRendererTextStyle val = constructObjectPropertyEnum "style" val data CellRendererTextStylePropertyInfo instance AttrInfo CellRendererTextStylePropertyInfo where type AttrAllowedOps CellRendererTextStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextStylePropertyInfo = (~) Pango.Style type AttrBaseTypeConstraint CellRendererTextStylePropertyInfo = CellRendererTextK type AttrGetType CellRendererTextStylePropertyInfo = Pango.Style type AttrLabel CellRendererTextStylePropertyInfo = "CellRendererText::style" attrGet _ = getCellRendererTextStyle attrSet _ = setCellRendererTextStyle attrConstruct _ = constructCellRendererTextStyle -- VVV Prop "style-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextStyleSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextStyleSet obj = liftIO $ getObjectPropertyBool obj "style-set" setCellRendererTextStyleSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextStyleSet obj val = liftIO $ setObjectPropertyBool obj "style-set" val constructCellRendererTextStyleSet :: Bool -> IO ([Char], GValue) constructCellRendererTextStyleSet val = constructObjectPropertyBool "style-set" val data CellRendererTextStyleSetPropertyInfo instance AttrInfo CellRendererTextStyleSetPropertyInfo where type AttrAllowedOps CellRendererTextStyleSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextStyleSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextStyleSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextStyleSetPropertyInfo = Bool type AttrLabel CellRendererTextStyleSetPropertyInfo = "CellRendererText::style-set" attrGet _ = getCellRendererTextStyleSet attrSet _ = setCellRendererTextStyleSet attrConstruct _ = constructCellRendererTextStyleSet -- VVV Prop "text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextText :: (MonadIO m, CellRendererTextK o) => o -> m T.Text getCellRendererTextText obj = liftIO $ getObjectPropertyString obj "text" setCellRendererTextText :: (MonadIO m, CellRendererTextK o) => o -> T.Text -> m () setCellRendererTextText obj val = liftIO $ setObjectPropertyString obj "text" val constructCellRendererTextText :: T.Text -> IO ([Char], GValue) constructCellRendererTextText val = constructObjectPropertyString "text" val data CellRendererTextTextPropertyInfo instance AttrInfo CellRendererTextTextPropertyInfo where type AttrAllowedOps CellRendererTextTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellRendererTextTextPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextTextPropertyInfo = T.Text type AttrLabel CellRendererTextTextPropertyInfo = "CellRendererText::text" attrGet _ = getCellRendererTextText attrSet _ = setCellRendererTextText attrConstruct _ = constructCellRendererTextText -- VVV Prop "underline" -- Type: TInterface "Pango" "Underline" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextUnderline :: (MonadIO m, CellRendererTextK o) => o -> m Pango.Underline getCellRendererTextUnderline obj = liftIO $ getObjectPropertyEnum obj "underline" setCellRendererTextUnderline :: (MonadIO m, CellRendererTextK o) => o -> Pango.Underline -> m () setCellRendererTextUnderline obj val = liftIO $ setObjectPropertyEnum obj "underline" val constructCellRendererTextUnderline :: Pango.Underline -> IO ([Char], GValue) constructCellRendererTextUnderline val = constructObjectPropertyEnum "underline" val data CellRendererTextUnderlinePropertyInfo instance AttrInfo CellRendererTextUnderlinePropertyInfo where type AttrAllowedOps CellRendererTextUnderlinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextUnderlinePropertyInfo = (~) Pango.Underline type AttrBaseTypeConstraint CellRendererTextUnderlinePropertyInfo = CellRendererTextK type AttrGetType CellRendererTextUnderlinePropertyInfo = Pango.Underline type AttrLabel CellRendererTextUnderlinePropertyInfo = "CellRendererText::underline" attrGet _ = getCellRendererTextUnderline attrSet _ = setCellRendererTextUnderline attrConstruct _ = constructCellRendererTextUnderline -- VVV Prop "underline-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextUnderlineSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextUnderlineSet obj = liftIO $ getObjectPropertyBool obj "underline-set" setCellRendererTextUnderlineSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextUnderlineSet obj val = liftIO $ setObjectPropertyBool obj "underline-set" val constructCellRendererTextUnderlineSet :: Bool -> IO ([Char], GValue) constructCellRendererTextUnderlineSet val = constructObjectPropertyBool "underline-set" val data CellRendererTextUnderlineSetPropertyInfo instance AttrInfo CellRendererTextUnderlineSetPropertyInfo where type AttrAllowedOps CellRendererTextUnderlineSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextUnderlineSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextUnderlineSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextUnderlineSetPropertyInfo = Bool type AttrLabel CellRendererTextUnderlineSetPropertyInfo = "CellRendererText::underline-set" attrGet _ = getCellRendererTextUnderlineSet attrSet _ = setCellRendererTextUnderlineSet attrConstruct _ = constructCellRendererTextUnderlineSet -- VVV Prop "variant" -- Type: TInterface "Pango" "Variant" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextVariant :: (MonadIO m, CellRendererTextK o) => o -> m Pango.Variant getCellRendererTextVariant obj = liftIO $ getObjectPropertyEnum obj "variant" setCellRendererTextVariant :: (MonadIO m, CellRendererTextK o) => o -> Pango.Variant -> m () setCellRendererTextVariant obj val = liftIO $ setObjectPropertyEnum obj "variant" val constructCellRendererTextVariant :: Pango.Variant -> IO ([Char], GValue) constructCellRendererTextVariant val = constructObjectPropertyEnum "variant" val data CellRendererTextVariantPropertyInfo instance AttrInfo CellRendererTextVariantPropertyInfo where type AttrAllowedOps CellRendererTextVariantPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextVariantPropertyInfo = (~) Pango.Variant type AttrBaseTypeConstraint CellRendererTextVariantPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextVariantPropertyInfo = Pango.Variant type AttrLabel CellRendererTextVariantPropertyInfo = "CellRendererText::variant" attrGet _ = getCellRendererTextVariant attrSet _ = setCellRendererTextVariant attrConstruct _ = constructCellRendererTextVariant -- VVV Prop "variant-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextVariantSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextVariantSet obj = liftIO $ getObjectPropertyBool obj "variant-set" setCellRendererTextVariantSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextVariantSet obj val = liftIO $ setObjectPropertyBool obj "variant-set" val constructCellRendererTextVariantSet :: Bool -> IO ([Char], GValue) constructCellRendererTextVariantSet val = constructObjectPropertyBool "variant-set" val data CellRendererTextVariantSetPropertyInfo instance AttrInfo CellRendererTextVariantSetPropertyInfo where type AttrAllowedOps CellRendererTextVariantSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextVariantSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextVariantSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextVariantSetPropertyInfo = Bool type AttrLabel CellRendererTextVariantSetPropertyInfo = "CellRendererText::variant-set" attrGet _ = getCellRendererTextVariantSet attrSet _ = setCellRendererTextVariantSet attrConstruct _ = constructCellRendererTextVariantSet -- VVV Prop "weight" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextWeight :: (MonadIO m, CellRendererTextK o) => o -> m Int32 getCellRendererTextWeight obj = liftIO $ getObjectPropertyCInt obj "weight" setCellRendererTextWeight :: (MonadIO m, CellRendererTextK o) => o -> Int32 -> m () setCellRendererTextWeight obj val = liftIO $ setObjectPropertyCInt obj "weight" val constructCellRendererTextWeight :: Int32 -> IO ([Char], GValue) constructCellRendererTextWeight val = constructObjectPropertyCInt "weight" val data CellRendererTextWeightPropertyInfo instance AttrInfo CellRendererTextWeightPropertyInfo where type AttrAllowedOps CellRendererTextWeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextWeightPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererTextWeightPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextWeightPropertyInfo = Int32 type AttrLabel CellRendererTextWeightPropertyInfo = "CellRendererText::weight" attrGet _ = getCellRendererTextWeight attrSet _ = setCellRendererTextWeight attrConstruct _ = constructCellRendererTextWeight -- VVV Prop "weight-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextWeightSet :: (MonadIO m, CellRendererTextK o) => o -> m Bool getCellRendererTextWeightSet obj = liftIO $ getObjectPropertyBool obj "weight-set" setCellRendererTextWeightSet :: (MonadIO m, CellRendererTextK o) => o -> Bool -> m () setCellRendererTextWeightSet obj val = liftIO $ setObjectPropertyBool obj "weight-set" val constructCellRendererTextWeightSet :: Bool -> IO ([Char], GValue) constructCellRendererTextWeightSet val = constructObjectPropertyBool "weight-set" val data CellRendererTextWeightSetPropertyInfo instance AttrInfo CellRendererTextWeightSetPropertyInfo where type AttrAllowedOps CellRendererTextWeightSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextWeightSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererTextWeightSetPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextWeightSetPropertyInfo = Bool type AttrLabel CellRendererTextWeightSetPropertyInfo = "CellRendererText::weight-set" attrGet _ = getCellRendererTextWeightSet attrSet _ = setCellRendererTextWeightSet attrConstruct _ = constructCellRendererTextWeightSet -- VVV Prop "width-chars" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextWidthChars :: (MonadIO m, CellRendererTextK o) => o -> m Int32 getCellRendererTextWidthChars obj = liftIO $ getObjectPropertyCInt obj "width-chars" setCellRendererTextWidthChars :: (MonadIO m, CellRendererTextK o) => o -> Int32 -> m () setCellRendererTextWidthChars obj val = liftIO $ setObjectPropertyCInt obj "width-chars" val constructCellRendererTextWidthChars :: Int32 -> IO ([Char], GValue) constructCellRendererTextWidthChars val = constructObjectPropertyCInt "width-chars" val data CellRendererTextWidthCharsPropertyInfo instance AttrInfo CellRendererTextWidthCharsPropertyInfo where type AttrAllowedOps CellRendererTextWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextWidthCharsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererTextWidthCharsPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextWidthCharsPropertyInfo = Int32 type AttrLabel CellRendererTextWidthCharsPropertyInfo = "CellRendererText::width-chars" attrGet _ = getCellRendererTextWidthChars attrSet _ = setCellRendererTextWidthChars attrConstruct _ = constructCellRendererTextWidthChars -- VVV Prop "wrap-mode" -- Type: TInterface "Pango" "WrapMode" -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextWrapMode :: (MonadIO m, CellRendererTextK o) => o -> m Pango.WrapMode getCellRendererTextWrapMode obj = liftIO $ getObjectPropertyEnum obj "wrap-mode" setCellRendererTextWrapMode :: (MonadIO m, CellRendererTextK o) => o -> Pango.WrapMode -> m () setCellRendererTextWrapMode obj val = liftIO $ setObjectPropertyEnum obj "wrap-mode" val constructCellRendererTextWrapMode :: Pango.WrapMode -> IO ([Char], GValue) constructCellRendererTextWrapMode val = constructObjectPropertyEnum "wrap-mode" val data CellRendererTextWrapModePropertyInfo instance AttrInfo CellRendererTextWrapModePropertyInfo where type AttrAllowedOps CellRendererTextWrapModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextWrapModePropertyInfo = (~) Pango.WrapMode type AttrBaseTypeConstraint CellRendererTextWrapModePropertyInfo = CellRendererTextK type AttrGetType CellRendererTextWrapModePropertyInfo = Pango.WrapMode type AttrLabel CellRendererTextWrapModePropertyInfo = "CellRendererText::wrap-mode" attrGet _ = getCellRendererTextWrapMode attrSet _ = setCellRendererTextWrapMode attrConstruct _ = constructCellRendererTextWrapMode -- VVV Prop "wrap-width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererTextWrapWidth :: (MonadIO m, CellRendererTextK o) => o -> m Int32 getCellRendererTextWrapWidth obj = liftIO $ getObjectPropertyCInt obj "wrap-width" setCellRendererTextWrapWidth :: (MonadIO m, CellRendererTextK o) => o -> Int32 -> m () setCellRendererTextWrapWidth obj val = liftIO $ setObjectPropertyCInt obj "wrap-width" val constructCellRendererTextWrapWidth :: Int32 -> IO ([Char], GValue) constructCellRendererTextWrapWidth val = constructObjectPropertyCInt "wrap-width" val data CellRendererTextWrapWidthPropertyInfo instance AttrInfo CellRendererTextWrapWidthPropertyInfo where type AttrAllowedOps CellRendererTextWrapWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererTextWrapWidthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererTextWrapWidthPropertyInfo = CellRendererTextK type AttrGetType CellRendererTextWrapWidthPropertyInfo = Int32 type AttrLabel CellRendererTextWrapWidthPropertyInfo = "CellRendererText::wrap-width" attrGet _ = getCellRendererTextWrapWidth attrSet _ = setCellRendererTextWrapWidth attrConstruct _ = constructCellRendererTextWrapWidth type instance AttributeList CellRendererText = '[ '("align-set", CellRendererTextAlignSetPropertyInfo), '("alignment", CellRendererTextAlignmentPropertyInfo), '("attributes", CellRendererTextAttributesPropertyInfo), '("background", CellRendererTextBackgroundPropertyInfo), '("background-gdk", CellRendererTextBackgroundGdkPropertyInfo), '("background-rgba", CellRendererTextBackgroundRgbaPropertyInfo), '("background-set", CellRendererTextBackgroundSetPropertyInfo), '("cell-background", CellRendererCellBackgroundPropertyInfo), '("cell-background-gdk", CellRendererCellBackgroundGdkPropertyInfo), '("cell-background-rgba", CellRendererCellBackgroundRgbaPropertyInfo), '("cell-background-set", CellRendererCellBackgroundSetPropertyInfo), '("editable", CellRendererTextEditablePropertyInfo), '("editable-set", CellRendererTextEditableSetPropertyInfo), '("editing", CellRendererEditingPropertyInfo), '("ellipsize", CellRendererTextEllipsizePropertyInfo), '("ellipsize-set", CellRendererTextEllipsizeSetPropertyInfo), '("family", CellRendererTextFamilyPropertyInfo), '("family-set", CellRendererTextFamilySetPropertyInfo), '("font", CellRendererTextFontPropertyInfo), '("font-desc", CellRendererTextFontDescPropertyInfo), '("foreground", CellRendererTextForegroundPropertyInfo), '("foreground-gdk", CellRendererTextForegroundGdkPropertyInfo), '("foreground-rgba", CellRendererTextForegroundRgbaPropertyInfo), '("foreground-set", CellRendererTextForegroundSetPropertyInfo), '("height", CellRendererHeightPropertyInfo), '("is-expanded", CellRendererIsExpandedPropertyInfo), '("is-expander", CellRendererIsExpanderPropertyInfo), '("language", CellRendererTextLanguagePropertyInfo), '("language-set", CellRendererTextLanguageSetPropertyInfo), '("markup", CellRendererTextMarkupPropertyInfo), '("max-width-chars", CellRendererTextMaxWidthCharsPropertyInfo), '("mode", CellRendererModePropertyInfo), '("placeholder-text", CellRendererTextPlaceholderTextPropertyInfo), '("rise", CellRendererTextRisePropertyInfo), '("rise-set", CellRendererTextRiseSetPropertyInfo), '("scale", CellRendererTextScalePropertyInfo), '("scale-set", CellRendererTextScaleSetPropertyInfo), '("sensitive", CellRendererSensitivePropertyInfo), '("single-paragraph-mode", CellRendererTextSingleParagraphModePropertyInfo), '("size", CellRendererTextSizePropertyInfo), '("size-points", CellRendererTextSizePointsPropertyInfo), '("size-set", CellRendererTextSizeSetPropertyInfo), '("stretch", CellRendererTextStretchPropertyInfo), '("stretch-set", CellRendererTextStretchSetPropertyInfo), '("strikethrough", CellRendererTextStrikethroughPropertyInfo), '("strikethrough-set", CellRendererTextStrikethroughSetPropertyInfo), '("style", CellRendererTextStylePropertyInfo), '("style-set", CellRendererTextStyleSetPropertyInfo), '("text", CellRendererTextTextPropertyInfo), '("underline", CellRendererTextUnderlinePropertyInfo), '("underline-set", CellRendererTextUnderlineSetPropertyInfo), '("variant", CellRendererTextVariantPropertyInfo), '("variant-set", CellRendererTextVariantSetPropertyInfo), '("visible", CellRendererVisiblePropertyInfo), '("weight", CellRendererTextWeightPropertyInfo), '("weight-set", CellRendererTextWeightSetPropertyInfo), '("width", CellRendererWidthPropertyInfo), '("width-chars", CellRendererTextWidthCharsPropertyInfo), '("wrap-mode", CellRendererTextWrapModePropertyInfo), '("wrap-width", CellRendererTextWrapWidthPropertyInfo), '("xalign", CellRendererXalignPropertyInfo), '("xpad", CellRendererXpadPropertyInfo), '("yalign", CellRendererYalignPropertyInfo), '("ypad", CellRendererYpadPropertyInfo)] -- VVV Prop "activatable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererToggleActivatable :: (MonadIO m, CellRendererToggleK o) => o -> m Bool getCellRendererToggleActivatable obj = liftIO $ getObjectPropertyBool obj "activatable" setCellRendererToggleActivatable :: (MonadIO m, CellRendererToggleK o) => o -> Bool -> m () setCellRendererToggleActivatable obj val = liftIO $ setObjectPropertyBool obj "activatable" val constructCellRendererToggleActivatable :: Bool -> IO ([Char], GValue) constructCellRendererToggleActivatable val = constructObjectPropertyBool "activatable" val data CellRendererToggleActivatablePropertyInfo instance AttrInfo CellRendererToggleActivatablePropertyInfo where type AttrAllowedOps CellRendererToggleActivatablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererToggleActivatablePropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererToggleActivatablePropertyInfo = CellRendererToggleK type AttrGetType CellRendererToggleActivatablePropertyInfo = Bool type AttrLabel CellRendererToggleActivatablePropertyInfo = "CellRendererToggle::activatable" attrGet _ = getCellRendererToggleActivatable attrSet _ = setCellRendererToggleActivatable attrConstruct _ = constructCellRendererToggleActivatable -- VVV Prop "active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererToggleActive :: (MonadIO m, CellRendererToggleK o) => o -> m Bool getCellRendererToggleActive obj = liftIO $ getObjectPropertyBool obj "active" setCellRendererToggleActive :: (MonadIO m, CellRendererToggleK o) => o -> Bool -> m () setCellRendererToggleActive obj val = liftIO $ setObjectPropertyBool obj "active" val constructCellRendererToggleActive :: Bool -> IO ([Char], GValue) constructCellRendererToggleActive val = constructObjectPropertyBool "active" val data CellRendererToggleActivePropertyInfo instance AttrInfo CellRendererToggleActivePropertyInfo where type AttrAllowedOps CellRendererToggleActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererToggleActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererToggleActivePropertyInfo = CellRendererToggleK type AttrGetType CellRendererToggleActivePropertyInfo = Bool type AttrLabel CellRendererToggleActivePropertyInfo = "CellRendererToggle::active" attrGet _ = getCellRendererToggleActive attrSet _ = setCellRendererToggleActive attrConstruct _ = constructCellRendererToggleActive -- VVV Prop "inconsistent" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererToggleInconsistent :: (MonadIO m, CellRendererToggleK o) => o -> m Bool getCellRendererToggleInconsistent obj = liftIO $ getObjectPropertyBool obj "inconsistent" setCellRendererToggleInconsistent :: (MonadIO m, CellRendererToggleK o) => o -> Bool -> m () setCellRendererToggleInconsistent obj val = liftIO $ setObjectPropertyBool obj "inconsistent" val constructCellRendererToggleInconsistent :: Bool -> IO ([Char], GValue) constructCellRendererToggleInconsistent val = constructObjectPropertyBool "inconsistent" val data CellRendererToggleInconsistentPropertyInfo instance AttrInfo CellRendererToggleInconsistentPropertyInfo where type AttrAllowedOps CellRendererToggleInconsistentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererToggleInconsistentPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererToggleInconsistentPropertyInfo = CellRendererToggleK type AttrGetType CellRendererToggleInconsistentPropertyInfo = Bool type AttrLabel CellRendererToggleInconsistentPropertyInfo = "CellRendererToggle::inconsistent" attrGet _ = getCellRendererToggleInconsistent attrSet _ = setCellRendererToggleInconsistent attrConstruct _ = constructCellRendererToggleInconsistent -- VVV Prop "indicator-size" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getCellRendererToggleIndicatorSize :: (MonadIO m, CellRendererToggleK o) => o -> m Int32 getCellRendererToggleIndicatorSize obj = liftIO $ getObjectPropertyCInt obj "indicator-size" setCellRendererToggleIndicatorSize :: (MonadIO m, CellRendererToggleK o) => o -> Int32 -> m () setCellRendererToggleIndicatorSize obj val = liftIO $ setObjectPropertyCInt obj "indicator-size" val constructCellRendererToggleIndicatorSize :: Int32 -> IO ([Char], GValue) constructCellRendererToggleIndicatorSize val = constructObjectPropertyCInt "indicator-size" val data CellRendererToggleIndicatorSizePropertyInfo instance AttrInfo CellRendererToggleIndicatorSizePropertyInfo where type AttrAllowedOps CellRendererToggleIndicatorSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererToggleIndicatorSizePropertyInfo = (~) Int32 type AttrBaseTypeConstraint CellRendererToggleIndicatorSizePropertyInfo = CellRendererToggleK type AttrGetType CellRendererToggleIndicatorSizePropertyInfo = Int32 type AttrLabel CellRendererToggleIndicatorSizePropertyInfo = "CellRendererToggle::indicator-size" attrGet _ = getCellRendererToggleIndicatorSize attrSet _ = setCellRendererToggleIndicatorSize attrConstruct _ = constructCellRendererToggleIndicatorSize -- VVV Prop "radio" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellRendererToggleRadio :: (MonadIO m, CellRendererToggleK o) => o -> m Bool getCellRendererToggleRadio obj = liftIO $ getObjectPropertyBool obj "radio" setCellRendererToggleRadio :: (MonadIO m, CellRendererToggleK o) => o -> Bool -> m () setCellRendererToggleRadio obj val = liftIO $ setObjectPropertyBool obj "radio" val constructCellRendererToggleRadio :: Bool -> IO ([Char], GValue) constructCellRendererToggleRadio val = constructObjectPropertyBool "radio" val data CellRendererToggleRadioPropertyInfo instance AttrInfo CellRendererToggleRadioPropertyInfo where type AttrAllowedOps CellRendererToggleRadioPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellRendererToggleRadioPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellRendererToggleRadioPropertyInfo = CellRendererToggleK type AttrGetType CellRendererToggleRadioPropertyInfo = Bool type AttrLabel CellRendererToggleRadioPropertyInfo = "CellRendererToggle::radio" attrGet _ = getCellRendererToggleRadio attrSet _ = setCellRendererToggleRadio attrConstruct _ = constructCellRendererToggleRadio type instance AttributeList CellRendererToggle = '[ '("activatable", CellRendererToggleActivatablePropertyInfo), '("active", CellRendererToggleActivePropertyInfo), '("cell-background", CellRendererCellBackgroundPropertyInfo), '("cell-background-gdk", CellRendererCellBackgroundGdkPropertyInfo), '("cell-background-rgba", CellRendererCellBackgroundRgbaPropertyInfo), '("cell-background-set", CellRendererCellBackgroundSetPropertyInfo), '("editing", CellRendererEditingPropertyInfo), '("height", CellRendererHeightPropertyInfo), '("inconsistent", CellRendererToggleInconsistentPropertyInfo), '("indicator-size", CellRendererToggleIndicatorSizePropertyInfo), '("is-expanded", CellRendererIsExpandedPropertyInfo), '("is-expander", CellRendererIsExpanderPropertyInfo), '("mode", CellRendererModePropertyInfo), '("radio", CellRendererToggleRadioPropertyInfo), '("sensitive", CellRendererSensitivePropertyInfo), '("visible", CellRendererVisiblePropertyInfo), '("width", CellRendererWidthPropertyInfo), '("xalign", CellRendererXalignPropertyInfo), '("xpad", CellRendererXpadPropertyInfo), '("yalign", CellRendererYalignPropertyInfo), '("ypad", CellRendererYpadPropertyInfo)] -- VVV Prop "background" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setCellViewBackground :: (MonadIO m, CellViewK o) => o -> T.Text -> m () setCellViewBackground obj val = liftIO $ setObjectPropertyString obj "background" val constructCellViewBackground :: T.Text -> IO ([Char], GValue) constructCellViewBackground val = constructObjectPropertyString "background" val data CellViewBackgroundPropertyInfo instance AttrInfo CellViewBackgroundPropertyInfo where type AttrAllowedOps CellViewBackgroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint CellViewBackgroundPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CellViewBackgroundPropertyInfo = CellViewK type AttrGetType CellViewBackgroundPropertyInfo = () type AttrLabel CellViewBackgroundPropertyInfo = "CellView::background" attrGet _ = undefined attrSet _ = setCellViewBackground attrConstruct _ = constructCellViewBackground -- VVV Prop "background-gdk" -- Type: TInterface "Gdk" "Color" -- Flags: [PropertyReadable,PropertyWritable] getCellViewBackgroundGdk :: (MonadIO m, CellViewK o) => o -> m Gdk.Color getCellViewBackgroundGdk obj = liftIO $ getObjectPropertyBoxed obj "background-gdk" Gdk.Color setCellViewBackgroundGdk :: (MonadIO m, CellViewK o) => o -> Gdk.Color -> m () setCellViewBackgroundGdk obj val = liftIO $ setObjectPropertyBoxed obj "background-gdk" val constructCellViewBackgroundGdk :: Gdk.Color -> IO ([Char], GValue) constructCellViewBackgroundGdk val = constructObjectPropertyBoxed "background-gdk" val data CellViewBackgroundGdkPropertyInfo instance AttrInfo CellViewBackgroundGdkPropertyInfo where type AttrAllowedOps CellViewBackgroundGdkPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellViewBackgroundGdkPropertyInfo = (~) Gdk.Color type AttrBaseTypeConstraint CellViewBackgroundGdkPropertyInfo = CellViewK type AttrGetType CellViewBackgroundGdkPropertyInfo = Gdk.Color type AttrLabel CellViewBackgroundGdkPropertyInfo = "CellView::background-gdk" attrGet _ = getCellViewBackgroundGdk attrSet _ = setCellViewBackgroundGdk attrConstruct _ = constructCellViewBackgroundGdk -- VVV Prop "background-rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getCellViewBackgroundRgba :: (MonadIO m, CellViewK o) => o -> m Gdk.RGBA getCellViewBackgroundRgba obj = liftIO $ getObjectPropertyBoxed obj "background-rgba" Gdk.RGBA setCellViewBackgroundRgba :: (MonadIO m, CellViewK o) => o -> Gdk.RGBA -> m () setCellViewBackgroundRgba obj val = liftIO $ setObjectPropertyBoxed obj "background-rgba" val constructCellViewBackgroundRgba :: Gdk.RGBA -> IO ([Char], GValue) constructCellViewBackgroundRgba val = constructObjectPropertyBoxed "background-rgba" val data CellViewBackgroundRgbaPropertyInfo instance AttrInfo CellViewBackgroundRgbaPropertyInfo where type AttrAllowedOps CellViewBackgroundRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellViewBackgroundRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint CellViewBackgroundRgbaPropertyInfo = CellViewK type AttrGetType CellViewBackgroundRgbaPropertyInfo = Gdk.RGBA type AttrLabel CellViewBackgroundRgbaPropertyInfo = "CellView::background-rgba" attrGet _ = getCellViewBackgroundRgba attrSet _ = setCellViewBackgroundRgba attrConstruct _ = constructCellViewBackgroundRgba -- VVV Prop "background-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellViewBackgroundSet :: (MonadIO m, CellViewK o) => o -> m Bool getCellViewBackgroundSet obj = liftIO $ getObjectPropertyBool obj "background-set" setCellViewBackgroundSet :: (MonadIO m, CellViewK o) => o -> Bool -> m () setCellViewBackgroundSet obj val = liftIO $ setObjectPropertyBool obj "background-set" val constructCellViewBackgroundSet :: Bool -> IO ([Char], GValue) constructCellViewBackgroundSet val = constructObjectPropertyBool "background-set" val data CellViewBackgroundSetPropertyInfo instance AttrInfo CellViewBackgroundSetPropertyInfo where type AttrAllowedOps CellViewBackgroundSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellViewBackgroundSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellViewBackgroundSetPropertyInfo = CellViewK type AttrGetType CellViewBackgroundSetPropertyInfo = Bool type AttrLabel CellViewBackgroundSetPropertyInfo = "CellView::background-set" attrGet _ = getCellViewBackgroundSet attrSet _ = setCellViewBackgroundSet attrConstruct _ = constructCellViewBackgroundSet -- VVV Prop "cell-area" -- Type: TInterface "Gtk" "CellArea" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getCellViewCellArea :: (MonadIO m, CellViewK o) => o -> m CellArea getCellViewCellArea obj = liftIO $ getObjectPropertyObject obj "cell-area" CellArea constructCellViewCellArea :: (CellAreaK a) => a -> IO ([Char], GValue) constructCellViewCellArea val = constructObjectPropertyObject "cell-area" val data CellViewCellAreaPropertyInfo instance AttrInfo CellViewCellAreaPropertyInfo where type AttrAllowedOps CellViewCellAreaPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellViewCellAreaPropertyInfo = CellAreaK type AttrBaseTypeConstraint CellViewCellAreaPropertyInfo = CellViewK type AttrGetType CellViewCellAreaPropertyInfo = CellArea type AttrLabel CellViewCellAreaPropertyInfo = "CellView::cell-area" attrGet _ = getCellViewCellArea attrSet _ = undefined attrConstruct _ = constructCellViewCellArea -- VVV Prop "cell-area-context" -- Type: TInterface "Gtk" "CellAreaContext" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getCellViewCellAreaContext :: (MonadIO m, CellViewK o) => o -> m CellAreaContext getCellViewCellAreaContext obj = liftIO $ getObjectPropertyObject obj "cell-area-context" CellAreaContext constructCellViewCellAreaContext :: (CellAreaContextK a) => a -> IO ([Char], GValue) constructCellViewCellAreaContext val = constructObjectPropertyObject "cell-area-context" val data CellViewCellAreaContextPropertyInfo instance AttrInfo CellViewCellAreaContextPropertyInfo where type AttrAllowedOps CellViewCellAreaContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellViewCellAreaContextPropertyInfo = CellAreaContextK type AttrBaseTypeConstraint CellViewCellAreaContextPropertyInfo = CellViewK type AttrGetType CellViewCellAreaContextPropertyInfo = CellAreaContext type AttrLabel CellViewCellAreaContextPropertyInfo = "CellView::cell-area-context" attrGet _ = getCellViewCellAreaContext attrSet _ = undefined attrConstruct _ = constructCellViewCellAreaContext -- VVV Prop "draw-sensitive" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellViewDrawSensitive :: (MonadIO m, CellViewK o) => o -> m Bool getCellViewDrawSensitive obj = liftIO $ getObjectPropertyBool obj "draw-sensitive" setCellViewDrawSensitive :: (MonadIO m, CellViewK o) => o -> Bool -> m () setCellViewDrawSensitive obj val = liftIO $ setObjectPropertyBool obj "draw-sensitive" val constructCellViewDrawSensitive :: Bool -> IO ([Char], GValue) constructCellViewDrawSensitive val = constructObjectPropertyBool "draw-sensitive" val data CellViewDrawSensitivePropertyInfo instance AttrInfo CellViewDrawSensitivePropertyInfo where type AttrAllowedOps CellViewDrawSensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellViewDrawSensitivePropertyInfo = (~) Bool type AttrBaseTypeConstraint CellViewDrawSensitivePropertyInfo = CellViewK type AttrGetType CellViewDrawSensitivePropertyInfo = Bool type AttrLabel CellViewDrawSensitivePropertyInfo = "CellView::draw-sensitive" attrGet _ = getCellViewDrawSensitive attrSet _ = setCellViewDrawSensitive attrConstruct _ = constructCellViewDrawSensitive -- VVV Prop "fit-model" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCellViewFitModel :: (MonadIO m, CellViewK o) => o -> m Bool getCellViewFitModel obj = liftIO $ getObjectPropertyBool obj "fit-model" setCellViewFitModel :: (MonadIO m, CellViewK o) => o -> Bool -> m () setCellViewFitModel obj val = liftIO $ setObjectPropertyBool obj "fit-model" val constructCellViewFitModel :: Bool -> IO ([Char], GValue) constructCellViewFitModel val = constructObjectPropertyBool "fit-model" val data CellViewFitModelPropertyInfo instance AttrInfo CellViewFitModelPropertyInfo where type AttrAllowedOps CellViewFitModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellViewFitModelPropertyInfo = (~) Bool type AttrBaseTypeConstraint CellViewFitModelPropertyInfo = CellViewK type AttrGetType CellViewFitModelPropertyInfo = Bool type AttrLabel CellViewFitModelPropertyInfo = "CellView::fit-model" attrGet _ = getCellViewFitModel attrSet _ = setCellViewFitModel attrConstruct _ = constructCellViewFitModel -- VVV Prop "model" -- Type: TInterface "Gtk" "TreeModel" -- Flags: [PropertyReadable,PropertyWritable] getCellViewModel :: (MonadIO m, CellViewK o) => o -> m TreeModel getCellViewModel obj = liftIO $ getObjectPropertyObject obj "model" TreeModel setCellViewModel :: (MonadIO m, CellViewK o, TreeModelK a) => o -> a -> m () setCellViewModel obj val = liftIO $ setObjectPropertyObject obj "model" val constructCellViewModel :: (TreeModelK a) => a -> IO ([Char], GValue) constructCellViewModel val = constructObjectPropertyObject "model" val data CellViewModelPropertyInfo instance AttrInfo CellViewModelPropertyInfo where type AttrAllowedOps CellViewModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CellViewModelPropertyInfo = TreeModelK type AttrBaseTypeConstraint CellViewModelPropertyInfo = CellViewK type AttrGetType CellViewModelPropertyInfo = TreeModel type AttrLabel CellViewModelPropertyInfo = "CellView::model" attrGet _ = getCellViewModel attrSet _ = setCellViewModel attrConstruct _ = constructCellViewModel type instance AttributeList CellView = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("background", CellViewBackgroundPropertyInfo), '("background-gdk", CellViewBackgroundGdkPropertyInfo), '("background-rgba", CellViewBackgroundRgbaPropertyInfo), '("background-set", CellViewBackgroundSetPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("cell-area", CellViewCellAreaPropertyInfo), '("cell-area-context", CellViewCellAreaContextPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-sensitive", CellViewDrawSensitivePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("fit-model", CellViewFitModelPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("model", CellViewModelPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList CheckButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("active", ToggleButtonActivePropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-indicator", ToggleButtonDrawIndicatorPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("inconsistent", ToggleButtonInconsistentPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] -- VVV Prop "active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCheckMenuItemActive :: (MonadIO m, CheckMenuItemK o) => o -> m Bool getCheckMenuItemActive obj = liftIO $ getObjectPropertyBool obj "active" setCheckMenuItemActive :: (MonadIO m, CheckMenuItemK o) => o -> Bool -> m () setCheckMenuItemActive obj val = liftIO $ setObjectPropertyBool obj "active" val constructCheckMenuItemActive :: Bool -> IO ([Char], GValue) constructCheckMenuItemActive val = constructObjectPropertyBool "active" val data CheckMenuItemActivePropertyInfo instance AttrInfo CheckMenuItemActivePropertyInfo where type AttrAllowedOps CheckMenuItemActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CheckMenuItemActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint CheckMenuItemActivePropertyInfo = CheckMenuItemK type AttrGetType CheckMenuItemActivePropertyInfo = Bool type AttrLabel CheckMenuItemActivePropertyInfo = "CheckMenuItem::active" attrGet _ = getCheckMenuItemActive attrSet _ = setCheckMenuItemActive attrConstruct _ = constructCheckMenuItemActive -- VVV Prop "draw-as-radio" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCheckMenuItemDrawAsRadio :: (MonadIO m, CheckMenuItemK o) => o -> m Bool getCheckMenuItemDrawAsRadio obj = liftIO $ getObjectPropertyBool obj "draw-as-radio" setCheckMenuItemDrawAsRadio :: (MonadIO m, CheckMenuItemK o) => o -> Bool -> m () setCheckMenuItemDrawAsRadio obj val = liftIO $ setObjectPropertyBool obj "draw-as-radio" val constructCheckMenuItemDrawAsRadio :: Bool -> IO ([Char], GValue) constructCheckMenuItemDrawAsRadio val = constructObjectPropertyBool "draw-as-radio" val data CheckMenuItemDrawAsRadioPropertyInfo instance AttrInfo CheckMenuItemDrawAsRadioPropertyInfo where type AttrAllowedOps CheckMenuItemDrawAsRadioPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CheckMenuItemDrawAsRadioPropertyInfo = (~) Bool type AttrBaseTypeConstraint CheckMenuItemDrawAsRadioPropertyInfo = CheckMenuItemK type AttrGetType CheckMenuItemDrawAsRadioPropertyInfo = Bool type AttrLabel CheckMenuItemDrawAsRadioPropertyInfo = "CheckMenuItem::draw-as-radio" attrGet _ = getCheckMenuItemDrawAsRadio attrSet _ = setCheckMenuItemDrawAsRadio attrConstruct _ = constructCheckMenuItemDrawAsRadio -- VVV Prop "inconsistent" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getCheckMenuItemInconsistent :: (MonadIO m, CheckMenuItemK o) => o -> m Bool getCheckMenuItemInconsistent obj = liftIO $ getObjectPropertyBool obj "inconsistent" setCheckMenuItemInconsistent :: (MonadIO m, CheckMenuItemK o) => o -> Bool -> m () setCheckMenuItemInconsistent obj val = liftIO $ setObjectPropertyBool obj "inconsistent" val constructCheckMenuItemInconsistent :: Bool -> IO ([Char], GValue) constructCheckMenuItemInconsistent val = constructObjectPropertyBool "inconsistent" val data CheckMenuItemInconsistentPropertyInfo instance AttrInfo CheckMenuItemInconsistentPropertyInfo where type AttrAllowedOps CheckMenuItemInconsistentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CheckMenuItemInconsistentPropertyInfo = (~) Bool type AttrBaseTypeConstraint CheckMenuItemInconsistentPropertyInfo = CheckMenuItemK type AttrGetType CheckMenuItemInconsistentPropertyInfo = Bool type AttrLabel CheckMenuItemInconsistentPropertyInfo = "CheckMenuItem::inconsistent" attrGet _ = getCheckMenuItemInconsistent attrSet _ = setCheckMenuItemInconsistent attrConstruct _ = constructCheckMenuItemInconsistent type instance AttributeList CheckMenuItem = '[ '("accel-path", MenuItemAccelPathPropertyInfo), '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("active", CheckMenuItemActivePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-as-radio", CheckMenuItemDrawAsRadioPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inconsistent", CheckMenuItemInconsistentPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", MenuItemLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("right-justified", MenuItemRightJustifiedPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("submenu", MenuItemSubmenuPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-underline", MenuItemUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList CheckMenuItemAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList Clipboard = '[ ] -- VVV Prop "alpha" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getColorButtonAlpha :: (MonadIO m, ColorButtonK o) => o -> m Word32 getColorButtonAlpha obj = liftIO $ getObjectPropertyCUInt obj "alpha" setColorButtonAlpha :: (MonadIO m, ColorButtonK o) => o -> Word32 -> m () setColorButtonAlpha obj val = liftIO $ setObjectPropertyCUInt obj "alpha" val constructColorButtonAlpha :: Word32 -> IO ([Char], GValue) constructColorButtonAlpha val = constructObjectPropertyCUInt "alpha" val data ColorButtonAlphaPropertyInfo instance AttrInfo ColorButtonAlphaPropertyInfo where type AttrAllowedOps ColorButtonAlphaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorButtonAlphaPropertyInfo = (~) Word32 type AttrBaseTypeConstraint ColorButtonAlphaPropertyInfo = ColorButtonK type AttrGetType ColorButtonAlphaPropertyInfo = Word32 type AttrLabel ColorButtonAlphaPropertyInfo = "ColorButton::alpha" attrGet _ = getColorButtonAlpha attrSet _ = setColorButtonAlpha attrConstruct _ = constructColorButtonAlpha -- VVV Prop "color" -- Type: TInterface "Gdk" "Color" -- Flags: [PropertyReadable,PropertyWritable] getColorButtonColor :: (MonadIO m, ColorButtonK o) => o -> m Gdk.Color getColorButtonColor obj = liftIO $ getObjectPropertyBoxed obj "color" Gdk.Color setColorButtonColor :: (MonadIO m, ColorButtonK o) => o -> Gdk.Color -> m () setColorButtonColor obj val = liftIO $ setObjectPropertyBoxed obj "color" val constructColorButtonColor :: Gdk.Color -> IO ([Char], GValue) constructColorButtonColor val = constructObjectPropertyBoxed "color" val data ColorButtonColorPropertyInfo instance AttrInfo ColorButtonColorPropertyInfo where type AttrAllowedOps ColorButtonColorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorButtonColorPropertyInfo = (~) Gdk.Color type AttrBaseTypeConstraint ColorButtonColorPropertyInfo = ColorButtonK type AttrGetType ColorButtonColorPropertyInfo = Gdk.Color type AttrLabel ColorButtonColorPropertyInfo = "ColorButton::color" attrGet _ = getColorButtonColor attrSet _ = setColorButtonColor attrConstruct _ = constructColorButtonColor -- VVV Prop "rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getColorButtonRgba :: (MonadIO m, ColorButtonK o) => o -> m Gdk.RGBA getColorButtonRgba obj = liftIO $ getObjectPropertyBoxed obj "rgba" Gdk.RGBA setColorButtonRgba :: (MonadIO m, ColorButtonK o) => o -> Gdk.RGBA -> m () setColorButtonRgba obj val = liftIO $ setObjectPropertyBoxed obj "rgba" val constructColorButtonRgba :: Gdk.RGBA -> IO ([Char], GValue) constructColorButtonRgba val = constructObjectPropertyBoxed "rgba" val data ColorButtonRgbaPropertyInfo instance AttrInfo ColorButtonRgbaPropertyInfo where type AttrAllowedOps ColorButtonRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorButtonRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint ColorButtonRgbaPropertyInfo = ColorButtonK type AttrGetType ColorButtonRgbaPropertyInfo = Gdk.RGBA type AttrLabel ColorButtonRgbaPropertyInfo = "ColorButton::rgba" attrGet _ = getColorButtonRgba attrSet _ = setColorButtonRgba attrConstruct _ = constructColorButtonRgba -- VVV Prop "title" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getColorButtonTitle :: (MonadIO m, ColorButtonK o) => o -> m T.Text getColorButtonTitle obj = liftIO $ getObjectPropertyString obj "title" setColorButtonTitle :: (MonadIO m, ColorButtonK o) => o -> T.Text -> m () setColorButtonTitle obj val = liftIO $ setObjectPropertyString obj "title" val constructColorButtonTitle :: T.Text -> IO ([Char], GValue) constructColorButtonTitle val = constructObjectPropertyString "title" val data ColorButtonTitlePropertyInfo instance AttrInfo ColorButtonTitlePropertyInfo where type AttrAllowedOps ColorButtonTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorButtonTitlePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ColorButtonTitlePropertyInfo = ColorButtonK type AttrGetType ColorButtonTitlePropertyInfo = T.Text type AttrLabel ColorButtonTitlePropertyInfo = "ColorButton::title" attrGet _ = getColorButtonTitle attrSet _ = setColorButtonTitle attrConstruct _ = constructColorButtonTitle -- VVV Prop "use-alpha" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getColorButtonUseAlpha :: (MonadIO m, ColorButtonK o) => o -> m Bool getColorButtonUseAlpha obj = liftIO $ getObjectPropertyBool obj "use-alpha" setColorButtonUseAlpha :: (MonadIO m, ColorButtonK o) => o -> Bool -> m () setColorButtonUseAlpha obj val = liftIO $ setObjectPropertyBool obj "use-alpha" val constructColorButtonUseAlpha :: Bool -> IO ([Char], GValue) constructColorButtonUseAlpha val = constructObjectPropertyBool "use-alpha" val data ColorButtonUseAlphaPropertyInfo instance AttrInfo ColorButtonUseAlphaPropertyInfo where type AttrAllowedOps ColorButtonUseAlphaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorButtonUseAlphaPropertyInfo = (~) Bool type AttrBaseTypeConstraint ColorButtonUseAlphaPropertyInfo = ColorButtonK type AttrGetType ColorButtonUseAlphaPropertyInfo = Bool type AttrLabel ColorButtonUseAlphaPropertyInfo = "ColorButton::use-alpha" attrGet _ = getColorButtonUseAlpha attrSet _ = setColorButtonUseAlpha attrConstruct _ = constructColorButtonUseAlpha type instance AttributeList ColorButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("alpha", ColorButtonAlphaPropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("color", ColorButtonColorPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("rgba", ColorButtonRgbaPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("title", ColorButtonTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-alpha", ColorButtonUseAlphaPropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] -- VVV Prop "rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getColorChooserRgba :: (MonadIO m, ColorChooserK o) => o -> m Gdk.RGBA getColorChooserRgba obj = liftIO $ getObjectPropertyBoxed obj "rgba" Gdk.RGBA setColorChooserRgba :: (MonadIO m, ColorChooserK o) => o -> Gdk.RGBA -> m () setColorChooserRgba obj val = liftIO $ setObjectPropertyBoxed obj "rgba" val constructColorChooserRgba :: Gdk.RGBA -> IO ([Char], GValue) constructColorChooserRgba val = constructObjectPropertyBoxed "rgba" val data ColorChooserRgbaPropertyInfo instance AttrInfo ColorChooserRgbaPropertyInfo where type AttrAllowedOps ColorChooserRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorChooserRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint ColorChooserRgbaPropertyInfo = ColorChooserK type AttrGetType ColorChooserRgbaPropertyInfo = Gdk.RGBA type AttrLabel ColorChooserRgbaPropertyInfo = "ColorChooser::rgba" attrGet _ = getColorChooserRgba attrSet _ = setColorChooserRgba attrConstruct _ = constructColorChooserRgba -- VVV Prop "use-alpha" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getColorChooserUseAlpha :: (MonadIO m, ColorChooserK o) => o -> m Bool getColorChooserUseAlpha obj = liftIO $ getObjectPropertyBool obj "use-alpha" setColorChooserUseAlpha :: (MonadIO m, ColorChooserK o) => o -> Bool -> m () setColorChooserUseAlpha obj val = liftIO $ setObjectPropertyBool obj "use-alpha" val constructColorChooserUseAlpha :: Bool -> IO ([Char], GValue) constructColorChooserUseAlpha val = constructObjectPropertyBool "use-alpha" val data ColorChooserUseAlphaPropertyInfo instance AttrInfo ColorChooserUseAlphaPropertyInfo where type AttrAllowedOps ColorChooserUseAlphaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorChooserUseAlphaPropertyInfo = (~) Bool type AttrBaseTypeConstraint ColorChooserUseAlphaPropertyInfo = ColorChooserK type AttrGetType ColorChooserUseAlphaPropertyInfo = Bool type AttrLabel ColorChooserUseAlphaPropertyInfo = "ColorChooser::use-alpha" attrGet _ = getColorChooserUseAlpha attrSet _ = setColorChooserUseAlpha attrConstruct _ = constructColorChooserUseAlpha type instance AttributeList ColorChooser = '[ '("rgba", ColorChooserRgbaPropertyInfo), '("use-alpha", ColorChooserUseAlphaPropertyInfo)] -- VVV Prop "show-editor" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getColorChooserDialogShowEditor :: (MonadIO m, ColorChooserDialogK o) => o -> m Bool getColorChooserDialogShowEditor obj = liftIO $ getObjectPropertyBool obj "show-editor" setColorChooserDialogShowEditor :: (MonadIO m, ColorChooserDialogK o) => o -> Bool -> m () setColorChooserDialogShowEditor obj val = liftIO $ setObjectPropertyBool obj "show-editor" val constructColorChooserDialogShowEditor :: Bool -> IO ([Char], GValue) constructColorChooserDialogShowEditor val = constructObjectPropertyBool "show-editor" val data ColorChooserDialogShowEditorPropertyInfo instance AttrInfo ColorChooserDialogShowEditorPropertyInfo where type AttrAllowedOps ColorChooserDialogShowEditorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorChooserDialogShowEditorPropertyInfo = (~) Bool type AttrBaseTypeConstraint ColorChooserDialogShowEditorPropertyInfo = ColorChooserDialogK type AttrGetType ColorChooserDialogShowEditorPropertyInfo = Bool type AttrLabel ColorChooserDialogShowEditorPropertyInfo = "ColorChooserDialog::show-editor" attrGet _ = getColorChooserDialogShowEditor attrSet _ = setColorChooserDialogShowEditor attrConstruct _ = constructColorChooserDialogShowEditor type instance AttributeList ColorChooserDialog = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("rgba", ColorChooserRgbaPropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-editor", ColorChooserDialogShowEditorPropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-alpha", ColorChooserUseAlphaPropertyInfo), '("use-header-bar", DialogUseHeaderBarPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] -- VVV Prop "show-editor" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getColorChooserWidgetShowEditor :: (MonadIO m, ColorChooserWidgetK o) => o -> m Bool getColorChooserWidgetShowEditor obj = liftIO $ getObjectPropertyBool obj "show-editor" setColorChooserWidgetShowEditor :: (MonadIO m, ColorChooserWidgetK o) => o -> Bool -> m () setColorChooserWidgetShowEditor obj val = liftIO $ setObjectPropertyBool obj "show-editor" val constructColorChooserWidgetShowEditor :: Bool -> IO ([Char], GValue) constructColorChooserWidgetShowEditor val = constructObjectPropertyBool "show-editor" val data ColorChooserWidgetShowEditorPropertyInfo instance AttrInfo ColorChooserWidgetShowEditorPropertyInfo where type AttrAllowedOps ColorChooserWidgetShowEditorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorChooserWidgetShowEditorPropertyInfo = (~) Bool type AttrBaseTypeConstraint ColorChooserWidgetShowEditorPropertyInfo = ColorChooserWidgetK type AttrGetType ColorChooserWidgetShowEditorPropertyInfo = Bool type AttrLabel ColorChooserWidgetShowEditorPropertyInfo = "ColorChooserWidget::show-editor" attrGet _ = getColorChooserWidgetShowEditor attrSet _ = setColorChooserWidgetShowEditor attrConstruct _ = constructColorChooserWidgetShowEditor type instance AttributeList ColorChooserWidget = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("rgba", ColorChooserRgbaPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-editor", ColorChooserWidgetShowEditorPropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-alpha", ColorChooserUseAlphaPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "current-alpha" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getColorSelectionCurrentAlpha :: (MonadIO m, ColorSelectionK o) => o -> m Word32 getColorSelectionCurrentAlpha obj = liftIO $ getObjectPropertyCUInt obj "current-alpha" setColorSelectionCurrentAlpha :: (MonadIO m, ColorSelectionK o) => o -> Word32 -> m () setColorSelectionCurrentAlpha obj val = liftIO $ setObjectPropertyCUInt obj "current-alpha" val constructColorSelectionCurrentAlpha :: Word32 -> IO ([Char], GValue) constructColorSelectionCurrentAlpha val = constructObjectPropertyCUInt "current-alpha" val data ColorSelectionCurrentAlphaPropertyInfo instance AttrInfo ColorSelectionCurrentAlphaPropertyInfo where type AttrAllowedOps ColorSelectionCurrentAlphaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorSelectionCurrentAlphaPropertyInfo = (~) Word32 type AttrBaseTypeConstraint ColorSelectionCurrentAlphaPropertyInfo = ColorSelectionK type AttrGetType ColorSelectionCurrentAlphaPropertyInfo = Word32 type AttrLabel ColorSelectionCurrentAlphaPropertyInfo = "ColorSelection::current-alpha" attrGet _ = getColorSelectionCurrentAlpha attrSet _ = setColorSelectionCurrentAlpha attrConstruct _ = constructColorSelectionCurrentAlpha -- VVV Prop "current-color" -- Type: TInterface "Gdk" "Color" -- Flags: [PropertyReadable,PropertyWritable] getColorSelectionCurrentColor :: (MonadIO m, ColorSelectionK o) => o -> m Gdk.Color getColorSelectionCurrentColor obj = liftIO $ getObjectPropertyBoxed obj "current-color" Gdk.Color setColorSelectionCurrentColor :: (MonadIO m, ColorSelectionK o) => o -> Gdk.Color -> m () setColorSelectionCurrentColor obj val = liftIO $ setObjectPropertyBoxed obj "current-color" val constructColorSelectionCurrentColor :: Gdk.Color -> IO ([Char], GValue) constructColorSelectionCurrentColor val = constructObjectPropertyBoxed "current-color" val data ColorSelectionCurrentColorPropertyInfo instance AttrInfo ColorSelectionCurrentColorPropertyInfo where type AttrAllowedOps ColorSelectionCurrentColorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorSelectionCurrentColorPropertyInfo = (~) Gdk.Color type AttrBaseTypeConstraint ColorSelectionCurrentColorPropertyInfo = ColorSelectionK type AttrGetType ColorSelectionCurrentColorPropertyInfo = Gdk.Color type AttrLabel ColorSelectionCurrentColorPropertyInfo = "ColorSelection::current-color" attrGet _ = getColorSelectionCurrentColor attrSet _ = setColorSelectionCurrentColor attrConstruct _ = constructColorSelectionCurrentColor -- VVV Prop "current-rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getColorSelectionCurrentRgba :: (MonadIO m, ColorSelectionK o) => o -> m Gdk.RGBA getColorSelectionCurrentRgba obj = liftIO $ getObjectPropertyBoxed obj "current-rgba" Gdk.RGBA setColorSelectionCurrentRgba :: (MonadIO m, ColorSelectionK o) => o -> Gdk.RGBA -> m () setColorSelectionCurrentRgba obj val = liftIO $ setObjectPropertyBoxed obj "current-rgba" val constructColorSelectionCurrentRgba :: Gdk.RGBA -> IO ([Char], GValue) constructColorSelectionCurrentRgba val = constructObjectPropertyBoxed "current-rgba" val data ColorSelectionCurrentRgbaPropertyInfo instance AttrInfo ColorSelectionCurrentRgbaPropertyInfo where type AttrAllowedOps ColorSelectionCurrentRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorSelectionCurrentRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint ColorSelectionCurrentRgbaPropertyInfo = ColorSelectionK type AttrGetType ColorSelectionCurrentRgbaPropertyInfo = Gdk.RGBA type AttrLabel ColorSelectionCurrentRgbaPropertyInfo = "ColorSelection::current-rgba" attrGet _ = getColorSelectionCurrentRgba attrSet _ = setColorSelectionCurrentRgba attrConstruct _ = constructColorSelectionCurrentRgba -- VVV Prop "has-opacity-control" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getColorSelectionHasOpacityControl :: (MonadIO m, ColorSelectionK o) => o -> m Bool getColorSelectionHasOpacityControl obj = liftIO $ getObjectPropertyBool obj "has-opacity-control" setColorSelectionHasOpacityControl :: (MonadIO m, ColorSelectionK o) => o -> Bool -> m () setColorSelectionHasOpacityControl obj val = liftIO $ setObjectPropertyBool obj "has-opacity-control" val constructColorSelectionHasOpacityControl :: Bool -> IO ([Char], GValue) constructColorSelectionHasOpacityControl val = constructObjectPropertyBool "has-opacity-control" val data ColorSelectionHasOpacityControlPropertyInfo instance AttrInfo ColorSelectionHasOpacityControlPropertyInfo where type AttrAllowedOps ColorSelectionHasOpacityControlPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorSelectionHasOpacityControlPropertyInfo = (~) Bool type AttrBaseTypeConstraint ColorSelectionHasOpacityControlPropertyInfo = ColorSelectionK type AttrGetType ColorSelectionHasOpacityControlPropertyInfo = Bool type AttrLabel ColorSelectionHasOpacityControlPropertyInfo = "ColorSelection::has-opacity-control" attrGet _ = getColorSelectionHasOpacityControl attrSet _ = setColorSelectionHasOpacityControl attrConstruct _ = constructColorSelectionHasOpacityControl -- VVV Prop "has-palette" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getColorSelectionHasPalette :: (MonadIO m, ColorSelectionK o) => o -> m Bool getColorSelectionHasPalette obj = liftIO $ getObjectPropertyBool obj "has-palette" setColorSelectionHasPalette :: (MonadIO m, ColorSelectionK o) => o -> Bool -> m () setColorSelectionHasPalette obj val = liftIO $ setObjectPropertyBool obj "has-palette" val constructColorSelectionHasPalette :: Bool -> IO ([Char], GValue) constructColorSelectionHasPalette val = constructObjectPropertyBool "has-palette" val data ColorSelectionHasPalettePropertyInfo instance AttrInfo ColorSelectionHasPalettePropertyInfo where type AttrAllowedOps ColorSelectionHasPalettePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ColorSelectionHasPalettePropertyInfo = (~) Bool type AttrBaseTypeConstraint ColorSelectionHasPalettePropertyInfo = ColorSelectionK type AttrGetType ColorSelectionHasPalettePropertyInfo = Bool type AttrLabel ColorSelectionHasPalettePropertyInfo = "ColorSelection::has-palette" attrGet _ = getColorSelectionHasPalette attrSet _ = setColorSelectionHasPalette attrConstruct _ = constructColorSelectionHasPalette type instance AttributeList ColorSelection = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("current-alpha", ColorSelectionCurrentAlphaPropertyInfo), '("current-color", ColorSelectionCurrentColorPropertyInfo), '("current-rgba", ColorSelectionCurrentRgbaPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-opacity-control", ColorSelectionHasOpacityControlPropertyInfo), '("has-palette", ColorSelectionHasPalettePropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "cancel-button" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable] getColorSelectionDialogCancelButton :: (MonadIO m, ColorSelectionDialogK o) => o -> m Widget getColorSelectionDialogCancelButton obj = liftIO $ getObjectPropertyObject obj "cancel-button" Widget data ColorSelectionDialogCancelButtonPropertyInfo instance AttrInfo ColorSelectionDialogCancelButtonPropertyInfo where type AttrAllowedOps ColorSelectionDialogCancelButtonPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ColorSelectionDialogCancelButtonPropertyInfo = (~) () type AttrBaseTypeConstraint ColorSelectionDialogCancelButtonPropertyInfo = ColorSelectionDialogK type AttrGetType ColorSelectionDialogCancelButtonPropertyInfo = Widget type AttrLabel ColorSelectionDialogCancelButtonPropertyInfo = "ColorSelectionDialog::cancel-button" attrGet _ = getColorSelectionDialogCancelButton attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "color-selection" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable] getColorSelectionDialogColorSelection :: (MonadIO m, ColorSelectionDialogK o) => o -> m Widget getColorSelectionDialogColorSelection obj = liftIO $ getObjectPropertyObject obj "color-selection" Widget data ColorSelectionDialogColorSelectionPropertyInfo instance AttrInfo ColorSelectionDialogColorSelectionPropertyInfo where type AttrAllowedOps ColorSelectionDialogColorSelectionPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ColorSelectionDialogColorSelectionPropertyInfo = (~) () type AttrBaseTypeConstraint ColorSelectionDialogColorSelectionPropertyInfo = ColorSelectionDialogK type AttrGetType ColorSelectionDialogColorSelectionPropertyInfo = Widget type AttrLabel ColorSelectionDialogColorSelectionPropertyInfo = "ColorSelectionDialog::color-selection" attrGet _ = getColorSelectionDialogColorSelection attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "help-button" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable] getColorSelectionDialogHelpButton :: (MonadIO m, ColorSelectionDialogK o) => o -> m Widget getColorSelectionDialogHelpButton obj = liftIO $ getObjectPropertyObject obj "help-button" Widget data ColorSelectionDialogHelpButtonPropertyInfo instance AttrInfo ColorSelectionDialogHelpButtonPropertyInfo where type AttrAllowedOps ColorSelectionDialogHelpButtonPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ColorSelectionDialogHelpButtonPropertyInfo = (~) () type AttrBaseTypeConstraint ColorSelectionDialogHelpButtonPropertyInfo = ColorSelectionDialogK type AttrGetType ColorSelectionDialogHelpButtonPropertyInfo = Widget type AttrLabel ColorSelectionDialogHelpButtonPropertyInfo = "ColorSelectionDialog::help-button" attrGet _ = getColorSelectionDialogHelpButton attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "ok-button" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable] getColorSelectionDialogOkButton :: (MonadIO m, ColorSelectionDialogK o) => o -> m Widget getColorSelectionDialogOkButton obj = liftIO $ getObjectPropertyObject obj "ok-button" Widget data ColorSelectionDialogOkButtonPropertyInfo instance AttrInfo ColorSelectionDialogOkButtonPropertyInfo where type AttrAllowedOps ColorSelectionDialogOkButtonPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ColorSelectionDialogOkButtonPropertyInfo = (~) () type AttrBaseTypeConstraint ColorSelectionDialogOkButtonPropertyInfo = ColorSelectionDialogK type AttrGetType ColorSelectionDialogOkButtonPropertyInfo = Widget type AttrLabel ColorSelectionDialogOkButtonPropertyInfo = "ColorSelectionDialog::ok-button" attrGet _ = getColorSelectionDialogOkButton attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList ColorSelectionDialog = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("cancel-button", ColorSelectionDialogCancelButtonPropertyInfo), '("child", ContainerChildPropertyInfo), '("color-selection", ColorSelectionDialogColorSelectionPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("help-button", ColorSelectionDialogHelpButtonPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("ok-button", ColorSelectionDialogOkButtonPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-header-bar", DialogUseHeaderBarPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] -- VVV Prop "active" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getComboBoxActive :: (MonadIO m, ComboBoxK o) => o -> m Int32 getComboBoxActive obj = liftIO $ getObjectPropertyCInt obj "active" setComboBoxActive :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m () setComboBoxActive obj val = liftIO $ setObjectPropertyCInt obj "active" val constructComboBoxActive :: Int32 -> IO ([Char], GValue) constructComboBoxActive val = constructObjectPropertyCInt "active" val data ComboBoxActivePropertyInfo instance AttrInfo ComboBoxActivePropertyInfo where type AttrAllowedOps ComboBoxActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxActivePropertyInfo = (~) Int32 type AttrBaseTypeConstraint ComboBoxActivePropertyInfo = ComboBoxK type AttrGetType ComboBoxActivePropertyInfo = Int32 type AttrLabel ComboBoxActivePropertyInfo = "ComboBox::active" attrGet _ = getComboBoxActive attrSet _ = setComboBoxActive attrConstruct _ = constructComboBoxActive -- VVV Prop "active-id" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getComboBoxActiveId :: (MonadIO m, ComboBoxK o) => o -> m T.Text getComboBoxActiveId obj = liftIO $ getObjectPropertyString obj "active-id" setComboBoxActiveId :: (MonadIO m, ComboBoxK o) => o -> T.Text -> m () setComboBoxActiveId obj val = liftIO $ setObjectPropertyString obj "active-id" val constructComboBoxActiveId :: T.Text -> IO ([Char], GValue) constructComboBoxActiveId val = constructObjectPropertyString "active-id" val data ComboBoxActiveIdPropertyInfo instance AttrInfo ComboBoxActiveIdPropertyInfo where type AttrAllowedOps ComboBoxActiveIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxActiveIdPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ComboBoxActiveIdPropertyInfo = ComboBoxK type AttrGetType ComboBoxActiveIdPropertyInfo = T.Text type AttrLabel ComboBoxActiveIdPropertyInfo = "ComboBox::active-id" attrGet _ = getComboBoxActiveId attrSet _ = setComboBoxActiveId attrConstruct _ = constructComboBoxActiveId -- VVV Prop "add-tearoffs" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getComboBoxAddTearoffs :: (MonadIO m, ComboBoxK o) => o -> m Bool getComboBoxAddTearoffs obj = liftIO $ getObjectPropertyBool obj "add-tearoffs" setComboBoxAddTearoffs :: (MonadIO m, ComboBoxK o) => o -> Bool -> m () setComboBoxAddTearoffs obj val = liftIO $ setObjectPropertyBool obj "add-tearoffs" val constructComboBoxAddTearoffs :: Bool -> IO ([Char], GValue) constructComboBoxAddTearoffs val = constructObjectPropertyBool "add-tearoffs" val data ComboBoxAddTearoffsPropertyInfo instance AttrInfo ComboBoxAddTearoffsPropertyInfo where type AttrAllowedOps ComboBoxAddTearoffsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxAddTearoffsPropertyInfo = (~) Bool type AttrBaseTypeConstraint ComboBoxAddTearoffsPropertyInfo = ComboBoxK type AttrGetType ComboBoxAddTearoffsPropertyInfo = Bool type AttrLabel ComboBoxAddTearoffsPropertyInfo = "ComboBox::add-tearoffs" attrGet _ = getComboBoxAddTearoffs attrSet _ = setComboBoxAddTearoffs attrConstruct _ = constructComboBoxAddTearoffs -- VVV Prop "button-sensitivity" -- Type: TInterface "Gtk" "SensitivityType" -- Flags: [PropertyReadable,PropertyWritable] getComboBoxButtonSensitivity :: (MonadIO m, ComboBoxK o) => o -> m SensitivityType getComboBoxButtonSensitivity obj = liftIO $ getObjectPropertyEnum obj "button-sensitivity" setComboBoxButtonSensitivity :: (MonadIO m, ComboBoxK o) => o -> SensitivityType -> m () setComboBoxButtonSensitivity obj val = liftIO $ setObjectPropertyEnum obj "button-sensitivity" val constructComboBoxButtonSensitivity :: SensitivityType -> IO ([Char], GValue) constructComboBoxButtonSensitivity val = constructObjectPropertyEnum "button-sensitivity" val data ComboBoxButtonSensitivityPropertyInfo instance AttrInfo ComboBoxButtonSensitivityPropertyInfo where type AttrAllowedOps ComboBoxButtonSensitivityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxButtonSensitivityPropertyInfo = (~) SensitivityType type AttrBaseTypeConstraint ComboBoxButtonSensitivityPropertyInfo = ComboBoxK type AttrGetType ComboBoxButtonSensitivityPropertyInfo = SensitivityType type AttrLabel ComboBoxButtonSensitivityPropertyInfo = "ComboBox::button-sensitivity" attrGet _ = getComboBoxButtonSensitivity attrSet _ = setComboBoxButtonSensitivity attrConstruct _ = constructComboBoxButtonSensitivity -- VVV Prop "cell-area" -- Type: TInterface "Gtk" "CellArea" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getComboBoxCellArea :: (MonadIO m, ComboBoxK o) => o -> m CellArea getComboBoxCellArea obj = liftIO $ getObjectPropertyObject obj "cell-area" CellArea constructComboBoxCellArea :: (CellAreaK a) => a -> IO ([Char], GValue) constructComboBoxCellArea val = constructObjectPropertyObject "cell-area" val data ComboBoxCellAreaPropertyInfo instance AttrInfo ComboBoxCellAreaPropertyInfo where type AttrAllowedOps ComboBoxCellAreaPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxCellAreaPropertyInfo = CellAreaK type AttrBaseTypeConstraint ComboBoxCellAreaPropertyInfo = ComboBoxK type AttrGetType ComboBoxCellAreaPropertyInfo = CellArea type AttrLabel ComboBoxCellAreaPropertyInfo = "ComboBox::cell-area" attrGet _ = getComboBoxCellArea attrSet _ = undefined attrConstruct _ = constructComboBoxCellArea -- VVV Prop "column-span-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getComboBoxColumnSpanColumn :: (MonadIO m, ComboBoxK o) => o -> m Int32 getComboBoxColumnSpanColumn obj = liftIO $ getObjectPropertyCInt obj "column-span-column" setComboBoxColumnSpanColumn :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m () setComboBoxColumnSpanColumn obj val = liftIO $ setObjectPropertyCInt obj "column-span-column" val constructComboBoxColumnSpanColumn :: Int32 -> IO ([Char], GValue) constructComboBoxColumnSpanColumn val = constructObjectPropertyCInt "column-span-column" val data ComboBoxColumnSpanColumnPropertyInfo instance AttrInfo ComboBoxColumnSpanColumnPropertyInfo where type AttrAllowedOps ComboBoxColumnSpanColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxColumnSpanColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ComboBoxColumnSpanColumnPropertyInfo = ComboBoxK type AttrGetType ComboBoxColumnSpanColumnPropertyInfo = Int32 type AttrLabel ComboBoxColumnSpanColumnPropertyInfo = "ComboBox::column-span-column" attrGet _ = getComboBoxColumnSpanColumn attrSet _ = setComboBoxColumnSpanColumn attrConstruct _ = constructComboBoxColumnSpanColumn -- VVV Prop "entry-text-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getComboBoxEntryTextColumn :: (MonadIO m, ComboBoxK o) => o -> m Int32 getComboBoxEntryTextColumn obj = liftIO $ getObjectPropertyCInt obj "entry-text-column" setComboBoxEntryTextColumn :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m () setComboBoxEntryTextColumn obj val = liftIO $ setObjectPropertyCInt obj "entry-text-column" val constructComboBoxEntryTextColumn :: Int32 -> IO ([Char], GValue) constructComboBoxEntryTextColumn val = constructObjectPropertyCInt "entry-text-column" val data ComboBoxEntryTextColumnPropertyInfo instance AttrInfo ComboBoxEntryTextColumnPropertyInfo where type AttrAllowedOps ComboBoxEntryTextColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxEntryTextColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ComboBoxEntryTextColumnPropertyInfo = ComboBoxK type AttrGetType ComboBoxEntryTextColumnPropertyInfo = Int32 type AttrLabel ComboBoxEntryTextColumnPropertyInfo = "ComboBox::entry-text-column" attrGet _ = getComboBoxEntryTextColumn attrSet _ = setComboBoxEntryTextColumn attrConstruct _ = constructComboBoxEntryTextColumn -- VVV Prop "focus-on-click" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getComboBoxFocusOnClick :: (MonadIO m, ComboBoxK o) => o -> m Bool getComboBoxFocusOnClick obj = liftIO $ getObjectPropertyBool obj "focus-on-click" setComboBoxFocusOnClick :: (MonadIO m, ComboBoxK o) => o -> Bool -> m () setComboBoxFocusOnClick obj val = liftIO $ setObjectPropertyBool obj "focus-on-click" val constructComboBoxFocusOnClick :: Bool -> IO ([Char], GValue) constructComboBoxFocusOnClick val = constructObjectPropertyBool "focus-on-click" val data ComboBoxFocusOnClickPropertyInfo instance AttrInfo ComboBoxFocusOnClickPropertyInfo where type AttrAllowedOps ComboBoxFocusOnClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxFocusOnClickPropertyInfo = (~) Bool type AttrBaseTypeConstraint ComboBoxFocusOnClickPropertyInfo = ComboBoxK type AttrGetType ComboBoxFocusOnClickPropertyInfo = Bool type AttrLabel ComboBoxFocusOnClickPropertyInfo = "ComboBox::focus-on-click" attrGet _ = getComboBoxFocusOnClick attrSet _ = setComboBoxFocusOnClick attrConstruct _ = constructComboBoxFocusOnClick -- VVV Prop "has-entry" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getComboBoxHasEntry :: (MonadIO m, ComboBoxK o) => o -> m Bool getComboBoxHasEntry obj = liftIO $ getObjectPropertyBool obj "has-entry" constructComboBoxHasEntry :: Bool -> IO ([Char], GValue) constructComboBoxHasEntry val = constructObjectPropertyBool "has-entry" val data ComboBoxHasEntryPropertyInfo instance AttrInfo ComboBoxHasEntryPropertyInfo where type AttrAllowedOps ComboBoxHasEntryPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxHasEntryPropertyInfo = (~) Bool type AttrBaseTypeConstraint ComboBoxHasEntryPropertyInfo = ComboBoxK type AttrGetType ComboBoxHasEntryPropertyInfo = Bool type AttrLabel ComboBoxHasEntryPropertyInfo = "ComboBox::has-entry" attrGet _ = getComboBoxHasEntry attrSet _ = undefined attrConstruct _ = constructComboBoxHasEntry -- VVV Prop "has-frame" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getComboBoxHasFrame :: (MonadIO m, ComboBoxK o) => o -> m Bool getComboBoxHasFrame obj = liftIO $ getObjectPropertyBool obj "has-frame" setComboBoxHasFrame :: (MonadIO m, ComboBoxK o) => o -> Bool -> m () setComboBoxHasFrame obj val = liftIO $ setObjectPropertyBool obj "has-frame" val constructComboBoxHasFrame :: Bool -> IO ([Char], GValue) constructComboBoxHasFrame val = constructObjectPropertyBool "has-frame" val data ComboBoxHasFramePropertyInfo instance AttrInfo ComboBoxHasFramePropertyInfo where type AttrAllowedOps ComboBoxHasFramePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxHasFramePropertyInfo = (~) Bool type AttrBaseTypeConstraint ComboBoxHasFramePropertyInfo = ComboBoxK type AttrGetType ComboBoxHasFramePropertyInfo = Bool type AttrLabel ComboBoxHasFramePropertyInfo = "ComboBox::has-frame" attrGet _ = getComboBoxHasFrame attrSet _ = setComboBoxHasFrame attrConstruct _ = constructComboBoxHasFrame -- VVV Prop "id-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getComboBoxIdColumn :: (MonadIO m, ComboBoxK o) => o -> m Int32 getComboBoxIdColumn obj = liftIO $ getObjectPropertyCInt obj "id-column" setComboBoxIdColumn :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m () setComboBoxIdColumn obj val = liftIO $ setObjectPropertyCInt obj "id-column" val constructComboBoxIdColumn :: Int32 -> IO ([Char], GValue) constructComboBoxIdColumn val = constructObjectPropertyCInt "id-column" val data ComboBoxIdColumnPropertyInfo instance AttrInfo ComboBoxIdColumnPropertyInfo where type AttrAllowedOps ComboBoxIdColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxIdColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ComboBoxIdColumnPropertyInfo = ComboBoxK type AttrGetType ComboBoxIdColumnPropertyInfo = Int32 type AttrLabel ComboBoxIdColumnPropertyInfo = "ComboBox::id-column" attrGet _ = getComboBoxIdColumn attrSet _ = setComboBoxIdColumn attrConstruct _ = constructComboBoxIdColumn -- VVV Prop "model" -- Type: TInterface "Gtk" "TreeModel" -- Flags: [PropertyReadable,PropertyWritable] getComboBoxModel :: (MonadIO m, ComboBoxK o) => o -> m TreeModel getComboBoxModel obj = liftIO $ getObjectPropertyObject obj "model" TreeModel setComboBoxModel :: (MonadIO m, ComboBoxK o, TreeModelK a) => o -> a -> m () setComboBoxModel obj val = liftIO $ setObjectPropertyObject obj "model" val constructComboBoxModel :: (TreeModelK a) => a -> IO ([Char], GValue) constructComboBoxModel val = constructObjectPropertyObject "model" val data ComboBoxModelPropertyInfo instance AttrInfo ComboBoxModelPropertyInfo where type AttrAllowedOps ComboBoxModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxModelPropertyInfo = TreeModelK type AttrBaseTypeConstraint ComboBoxModelPropertyInfo = ComboBoxK type AttrGetType ComboBoxModelPropertyInfo = TreeModel type AttrLabel ComboBoxModelPropertyInfo = "ComboBox::model" attrGet _ = getComboBoxModel attrSet _ = setComboBoxModel attrConstruct _ = constructComboBoxModel -- VVV Prop "popup-fixed-width" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getComboBoxPopupFixedWidth :: (MonadIO m, ComboBoxK o) => o -> m Bool getComboBoxPopupFixedWidth obj = liftIO $ getObjectPropertyBool obj "popup-fixed-width" setComboBoxPopupFixedWidth :: (MonadIO m, ComboBoxK o) => o -> Bool -> m () setComboBoxPopupFixedWidth obj val = liftIO $ setObjectPropertyBool obj "popup-fixed-width" val constructComboBoxPopupFixedWidth :: Bool -> IO ([Char], GValue) constructComboBoxPopupFixedWidth val = constructObjectPropertyBool "popup-fixed-width" val data ComboBoxPopupFixedWidthPropertyInfo instance AttrInfo ComboBoxPopupFixedWidthPropertyInfo where type AttrAllowedOps ComboBoxPopupFixedWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxPopupFixedWidthPropertyInfo = (~) Bool type AttrBaseTypeConstraint ComboBoxPopupFixedWidthPropertyInfo = ComboBoxK type AttrGetType ComboBoxPopupFixedWidthPropertyInfo = Bool type AttrLabel ComboBoxPopupFixedWidthPropertyInfo = "ComboBox::popup-fixed-width" attrGet _ = getComboBoxPopupFixedWidth attrSet _ = setComboBoxPopupFixedWidth attrConstruct _ = constructComboBoxPopupFixedWidth -- VVV Prop "popup-shown" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getComboBoxPopupShown :: (MonadIO m, ComboBoxK o) => o -> m Bool getComboBoxPopupShown obj = liftIO $ getObjectPropertyBool obj "popup-shown" data ComboBoxPopupShownPropertyInfo instance AttrInfo ComboBoxPopupShownPropertyInfo where type AttrAllowedOps ComboBoxPopupShownPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ComboBoxPopupShownPropertyInfo = (~) () type AttrBaseTypeConstraint ComboBoxPopupShownPropertyInfo = ComboBoxK type AttrGetType ComboBoxPopupShownPropertyInfo = Bool type AttrLabel ComboBoxPopupShownPropertyInfo = "ComboBox::popup-shown" attrGet _ = getComboBoxPopupShown attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "row-span-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getComboBoxRowSpanColumn :: (MonadIO m, ComboBoxK o) => o -> m Int32 getComboBoxRowSpanColumn obj = liftIO $ getObjectPropertyCInt obj "row-span-column" setComboBoxRowSpanColumn :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m () setComboBoxRowSpanColumn obj val = liftIO $ setObjectPropertyCInt obj "row-span-column" val constructComboBoxRowSpanColumn :: Int32 -> IO ([Char], GValue) constructComboBoxRowSpanColumn val = constructObjectPropertyCInt "row-span-column" val data ComboBoxRowSpanColumnPropertyInfo instance AttrInfo ComboBoxRowSpanColumnPropertyInfo where type AttrAllowedOps ComboBoxRowSpanColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxRowSpanColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ComboBoxRowSpanColumnPropertyInfo = ComboBoxK type AttrGetType ComboBoxRowSpanColumnPropertyInfo = Int32 type AttrLabel ComboBoxRowSpanColumnPropertyInfo = "ComboBox::row-span-column" attrGet _ = getComboBoxRowSpanColumn attrSet _ = setComboBoxRowSpanColumn attrConstruct _ = constructComboBoxRowSpanColumn -- VVV Prop "tearoff-title" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getComboBoxTearoffTitle :: (MonadIO m, ComboBoxK o) => o -> m T.Text getComboBoxTearoffTitle obj = liftIO $ getObjectPropertyString obj "tearoff-title" setComboBoxTearoffTitle :: (MonadIO m, ComboBoxK o) => o -> T.Text -> m () setComboBoxTearoffTitle obj val = liftIO $ setObjectPropertyString obj "tearoff-title" val constructComboBoxTearoffTitle :: T.Text -> IO ([Char], GValue) constructComboBoxTearoffTitle val = constructObjectPropertyString "tearoff-title" val data ComboBoxTearoffTitlePropertyInfo instance AttrInfo ComboBoxTearoffTitlePropertyInfo where type AttrAllowedOps ComboBoxTearoffTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxTearoffTitlePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ComboBoxTearoffTitlePropertyInfo = ComboBoxK type AttrGetType ComboBoxTearoffTitlePropertyInfo = T.Text type AttrLabel ComboBoxTearoffTitlePropertyInfo = "ComboBox::tearoff-title" attrGet _ = getComboBoxTearoffTitle attrSet _ = setComboBoxTearoffTitle attrConstruct _ = constructComboBoxTearoffTitle -- VVV Prop "wrap-width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getComboBoxWrapWidth :: (MonadIO m, ComboBoxK o) => o -> m Int32 getComboBoxWrapWidth obj = liftIO $ getObjectPropertyCInt obj "wrap-width" setComboBoxWrapWidth :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m () setComboBoxWrapWidth obj val = liftIO $ setObjectPropertyCInt obj "wrap-width" val constructComboBoxWrapWidth :: Int32 -> IO ([Char], GValue) constructComboBoxWrapWidth val = constructObjectPropertyCInt "wrap-width" val data ComboBoxWrapWidthPropertyInfo instance AttrInfo ComboBoxWrapWidthPropertyInfo where type AttrAllowedOps ComboBoxWrapWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ComboBoxWrapWidthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ComboBoxWrapWidthPropertyInfo = ComboBoxK type AttrGetType ComboBoxWrapWidthPropertyInfo = Int32 type AttrLabel ComboBoxWrapWidthPropertyInfo = "ComboBox::wrap-width" attrGet _ = getComboBoxWrapWidth attrSet _ = setComboBoxWrapWidth attrConstruct _ = constructComboBoxWrapWidth type instance AttributeList ComboBox = '[ '("active", ComboBoxActivePropertyInfo), '("active-id", ComboBoxActiveIdPropertyInfo), '("add-tearoffs", ComboBoxAddTearoffsPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("button-sensitivity", ComboBoxButtonSensitivityPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("cell-area", ComboBoxCellAreaPropertyInfo), '("child", ContainerChildPropertyInfo), '("column-span-column", ComboBoxColumnSpanColumnPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("editing-canceled", CellEditableEditingCanceledPropertyInfo), '("entry-text-column", ComboBoxEntryTextColumnPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ComboBoxFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-entry", ComboBoxHasEntryPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-frame", ComboBoxHasFramePropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("id-column", ComboBoxIdColumnPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("model", ComboBoxModelPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("popup-fixed-width", ComboBoxPopupFixedWidthPropertyInfo), '("popup-shown", ComboBoxPopupShownPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("row-span-column", ComboBoxRowSpanColumnPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tearoff-title", ComboBoxTearoffTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("wrap-width", ComboBoxWrapWidthPropertyInfo)] type instance AttributeList ComboBoxAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList ComboBoxText = '[ '("active", ComboBoxActivePropertyInfo), '("active-id", ComboBoxActiveIdPropertyInfo), '("add-tearoffs", ComboBoxAddTearoffsPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("button-sensitivity", ComboBoxButtonSensitivityPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("cell-area", ComboBoxCellAreaPropertyInfo), '("child", ContainerChildPropertyInfo), '("column-span-column", ComboBoxColumnSpanColumnPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("editing-canceled", CellEditableEditingCanceledPropertyInfo), '("entry-text-column", ComboBoxEntryTextColumnPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ComboBoxFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-entry", ComboBoxHasEntryPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-frame", ComboBoxHasFramePropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("id-column", ComboBoxIdColumnPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("model", ComboBoxModelPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("popup-fixed-width", ComboBoxPopupFixedWidthPropertyInfo), '("popup-shown", ComboBoxPopupShownPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("row-span-column", ComboBoxRowSpanColumnPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tearoff-title", ComboBoxTearoffTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("wrap-width", ComboBoxWrapWidthPropertyInfo)] -- VVV Prop "border-width" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getContainerBorderWidth :: (MonadIO m, ContainerK o) => o -> m Word32 getContainerBorderWidth obj = liftIO $ getObjectPropertyCUInt obj "border-width" setContainerBorderWidth :: (MonadIO m, ContainerK o) => o -> Word32 -> m () setContainerBorderWidth obj val = liftIO $ setObjectPropertyCUInt obj "border-width" val constructContainerBorderWidth :: Word32 -> IO ([Char], GValue) constructContainerBorderWidth val = constructObjectPropertyCUInt "border-width" val data ContainerBorderWidthPropertyInfo instance AttrInfo ContainerBorderWidthPropertyInfo where type AttrAllowedOps ContainerBorderWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ContainerBorderWidthPropertyInfo = (~) Word32 type AttrBaseTypeConstraint ContainerBorderWidthPropertyInfo = ContainerK type AttrGetType ContainerBorderWidthPropertyInfo = Word32 type AttrLabel ContainerBorderWidthPropertyInfo = "Container::border-width" attrGet _ = getContainerBorderWidth attrSet _ = setContainerBorderWidth attrConstruct _ = constructContainerBorderWidth -- VVV Prop "child" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyWritable] setContainerChild :: (MonadIO m, ContainerK o, WidgetK a) => o -> a -> m () setContainerChild obj val = liftIO $ setObjectPropertyObject obj "child" val constructContainerChild :: (WidgetK a) => a -> IO ([Char], GValue) constructContainerChild val = constructObjectPropertyObject "child" val data ContainerChildPropertyInfo instance AttrInfo ContainerChildPropertyInfo where type AttrAllowedOps ContainerChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint ContainerChildPropertyInfo = WidgetK type AttrBaseTypeConstraint ContainerChildPropertyInfo = ContainerK type AttrGetType ContainerChildPropertyInfo = () type AttrLabel ContainerChildPropertyInfo = "Container::child" attrGet _ = undefined attrSet _ = setContainerChild attrConstruct _ = constructContainerChild -- VVV Prop "resize-mode" -- Type: TInterface "Gtk" "ResizeMode" -- Flags: [PropertyReadable,PropertyWritable] getContainerResizeMode :: (MonadIO m, ContainerK o) => o -> m ResizeMode getContainerResizeMode obj = liftIO $ getObjectPropertyEnum obj "resize-mode" setContainerResizeMode :: (MonadIO m, ContainerK o) => o -> ResizeMode -> m () setContainerResizeMode obj val = liftIO $ setObjectPropertyEnum obj "resize-mode" val constructContainerResizeMode :: ResizeMode -> IO ([Char], GValue) constructContainerResizeMode val = constructObjectPropertyEnum "resize-mode" val data ContainerResizeModePropertyInfo instance AttrInfo ContainerResizeModePropertyInfo where type AttrAllowedOps ContainerResizeModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ContainerResizeModePropertyInfo = (~) ResizeMode type AttrBaseTypeConstraint ContainerResizeModePropertyInfo = ContainerK type AttrGetType ContainerResizeModePropertyInfo = ResizeMode type AttrLabel ContainerResizeModePropertyInfo = "Container::resize-mode" attrGet _ = getContainerResizeMode attrSet _ = setContainerResizeMode attrConstruct _ = constructContainerResizeMode type instance AttributeList Container = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList ContainerAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList ContainerCellAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList CssProvider = '[ ] -- VVV Prop "use-header-bar" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDialogUseHeaderBar :: (MonadIO m, DialogK o) => o -> m Int32 getDialogUseHeaderBar obj = liftIO $ getObjectPropertyCInt obj "use-header-bar" constructDialogUseHeaderBar :: Int32 -> IO ([Char], GValue) constructDialogUseHeaderBar val = constructObjectPropertyCInt "use-header-bar" val data DialogUseHeaderBarPropertyInfo instance AttrInfo DialogUseHeaderBarPropertyInfo where type AttrAllowedOps DialogUseHeaderBarPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DialogUseHeaderBarPropertyInfo = (~) Int32 type AttrBaseTypeConstraint DialogUseHeaderBarPropertyInfo = DialogK type AttrGetType DialogUseHeaderBarPropertyInfo = Int32 type AttrLabel DialogUseHeaderBarPropertyInfo = "Dialog::use-header-bar" attrGet _ = getDialogUseHeaderBar attrSet _ = undefined attrConstruct _ = constructDialogUseHeaderBar type instance AttributeList Dialog = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-header-bar", DialogUseHeaderBarPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] type instance AttributeList DrawingArea = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList Editable = '[ ] -- VVV Prop "activates-default" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryActivatesDefault :: (MonadIO m, EntryK o) => o -> m Bool getEntryActivatesDefault obj = liftIO $ getObjectPropertyBool obj "activates-default" setEntryActivatesDefault :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryActivatesDefault obj val = liftIO $ setObjectPropertyBool obj "activates-default" val constructEntryActivatesDefault :: Bool -> IO ([Char], GValue) constructEntryActivatesDefault val = constructObjectPropertyBool "activates-default" val data EntryActivatesDefaultPropertyInfo instance AttrInfo EntryActivatesDefaultPropertyInfo where type AttrAllowedOps EntryActivatesDefaultPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryActivatesDefaultPropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryActivatesDefaultPropertyInfo = EntryK type AttrGetType EntryActivatesDefaultPropertyInfo = Bool type AttrLabel EntryActivatesDefaultPropertyInfo = "Entry::activates-default" attrGet _ = getEntryActivatesDefault attrSet _ = setEntryActivatesDefault attrConstruct _ = constructEntryActivatesDefault -- VVV Prop "attributes" -- Type: TInterface "Pango" "AttrList" -- Flags: [PropertyReadable,PropertyWritable] getEntryAttributes :: (MonadIO m, EntryK o) => o -> m Pango.AttrList getEntryAttributes obj = liftIO $ getObjectPropertyBoxed obj "attributes" Pango.AttrList setEntryAttributes :: (MonadIO m, EntryK o) => o -> Pango.AttrList -> m () setEntryAttributes obj val = liftIO $ setObjectPropertyBoxed obj "attributes" val constructEntryAttributes :: Pango.AttrList -> IO ([Char], GValue) constructEntryAttributes val = constructObjectPropertyBoxed "attributes" val data EntryAttributesPropertyInfo instance AttrInfo EntryAttributesPropertyInfo where type AttrAllowedOps EntryAttributesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryAttributesPropertyInfo = (~) Pango.AttrList type AttrBaseTypeConstraint EntryAttributesPropertyInfo = EntryK type AttrGetType EntryAttributesPropertyInfo = Pango.AttrList type AttrLabel EntryAttributesPropertyInfo = "Entry::attributes" attrGet _ = getEntryAttributes attrSet _ = setEntryAttributes attrConstruct _ = constructEntryAttributes -- VVV Prop "buffer" -- Type: TInterface "Gtk" "EntryBuffer" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getEntryBuffer :: (MonadIO m, EntryK o) => o -> m EntryBuffer getEntryBuffer obj = liftIO $ getObjectPropertyObject obj "buffer" EntryBuffer setEntryBuffer :: (MonadIO m, EntryK o, EntryBufferK a) => o -> a -> m () setEntryBuffer obj val = liftIO $ setObjectPropertyObject obj "buffer" val constructEntryBuffer :: (EntryBufferK a) => a -> IO ([Char], GValue) constructEntryBuffer val = constructObjectPropertyObject "buffer" val data EntryBufferPropertyInfo instance AttrInfo EntryBufferPropertyInfo where type AttrAllowedOps EntryBufferPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryBufferPropertyInfo = EntryBufferK type AttrBaseTypeConstraint EntryBufferPropertyInfo = EntryK type AttrGetType EntryBufferPropertyInfo = EntryBuffer type AttrLabel EntryBufferPropertyInfo = "Entry::buffer" attrGet _ = getEntryBuffer attrSet _ = setEntryBuffer attrConstruct _ = constructEntryBuffer -- VVV Prop "caps-lock-warning" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryCapsLockWarning :: (MonadIO m, EntryK o) => o -> m Bool getEntryCapsLockWarning obj = liftIO $ getObjectPropertyBool obj "caps-lock-warning" setEntryCapsLockWarning :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryCapsLockWarning obj val = liftIO $ setObjectPropertyBool obj "caps-lock-warning" val constructEntryCapsLockWarning :: Bool -> IO ([Char], GValue) constructEntryCapsLockWarning val = constructObjectPropertyBool "caps-lock-warning" val data EntryCapsLockWarningPropertyInfo instance AttrInfo EntryCapsLockWarningPropertyInfo where type AttrAllowedOps EntryCapsLockWarningPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCapsLockWarningPropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryCapsLockWarningPropertyInfo = EntryK type AttrGetType EntryCapsLockWarningPropertyInfo = Bool type AttrLabel EntryCapsLockWarningPropertyInfo = "Entry::caps-lock-warning" attrGet _ = getEntryCapsLockWarning attrSet _ = setEntryCapsLockWarning attrConstruct _ = constructEntryCapsLockWarning -- VVV Prop "completion" -- Type: TInterface "Gtk" "EntryCompletion" -- Flags: [PropertyReadable,PropertyWritable] getEntryCompletion :: (MonadIO m, EntryK o) => o -> m EntryCompletion getEntryCompletion obj = liftIO $ getObjectPropertyObject obj "completion" EntryCompletion setEntryCompletion :: (MonadIO m, EntryK o, EntryCompletionK a) => o -> a -> m () setEntryCompletion obj val = liftIO $ setObjectPropertyObject obj "completion" val constructEntryCompletion :: (EntryCompletionK a) => a -> IO ([Char], GValue) constructEntryCompletion val = constructObjectPropertyObject "completion" val data EntryCompletionPropertyInfo instance AttrInfo EntryCompletionPropertyInfo where type AttrAllowedOps EntryCompletionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCompletionPropertyInfo = EntryCompletionK type AttrBaseTypeConstraint EntryCompletionPropertyInfo = EntryK type AttrGetType EntryCompletionPropertyInfo = EntryCompletion type AttrLabel EntryCompletionPropertyInfo = "Entry::completion" attrGet _ = getEntryCompletion attrSet _ = setEntryCompletion attrConstruct _ = constructEntryCompletion -- VVV Prop "cursor-position" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getEntryCursorPosition :: (MonadIO m, EntryK o) => o -> m Int32 getEntryCursorPosition obj = liftIO $ getObjectPropertyCInt obj "cursor-position" data EntryCursorPositionPropertyInfo instance AttrInfo EntryCursorPositionPropertyInfo where type AttrAllowedOps EntryCursorPositionPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint EntryCursorPositionPropertyInfo = (~) () type AttrBaseTypeConstraint EntryCursorPositionPropertyInfo = EntryK type AttrGetType EntryCursorPositionPropertyInfo = Int32 type AttrLabel EntryCursorPositionPropertyInfo = "Entry::cursor-position" attrGet _ = getEntryCursorPosition attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "editable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryEditable :: (MonadIO m, EntryK o) => o -> m Bool getEntryEditable obj = liftIO $ getObjectPropertyBool obj "editable" setEntryEditable :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryEditable obj val = liftIO $ setObjectPropertyBool obj "editable" val constructEntryEditable :: Bool -> IO ([Char], GValue) constructEntryEditable val = constructObjectPropertyBool "editable" val data EntryEditablePropertyInfo instance AttrInfo EntryEditablePropertyInfo where type AttrAllowedOps EntryEditablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryEditablePropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryEditablePropertyInfo = EntryK type AttrGetType EntryEditablePropertyInfo = Bool type AttrLabel EntryEditablePropertyInfo = "Entry::editable" attrGet _ = getEntryEditable attrSet _ = setEntryEditable attrConstruct _ = constructEntryEditable -- VVV Prop "has-frame" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryHasFrame :: (MonadIO m, EntryK o) => o -> m Bool getEntryHasFrame obj = liftIO $ getObjectPropertyBool obj "has-frame" setEntryHasFrame :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryHasFrame obj val = liftIO $ setObjectPropertyBool obj "has-frame" val constructEntryHasFrame :: Bool -> IO ([Char], GValue) constructEntryHasFrame val = constructObjectPropertyBool "has-frame" val data EntryHasFramePropertyInfo instance AttrInfo EntryHasFramePropertyInfo where type AttrAllowedOps EntryHasFramePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryHasFramePropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryHasFramePropertyInfo = EntryK type AttrGetType EntryHasFramePropertyInfo = Bool type AttrLabel EntryHasFramePropertyInfo = "Entry::has-frame" attrGet _ = getEntryHasFrame attrSet _ = setEntryHasFrame attrConstruct _ = constructEntryHasFrame -- VVV Prop "im-module" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntryImModule :: (MonadIO m, EntryK o) => o -> m T.Text getEntryImModule obj = liftIO $ getObjectPropertyString obj "im-module" setEntryImModule :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntryImModule obj val = liftIO $ setObjectPropertyString obj "im-module" val constructEntryImModule :: T.Text -> IO ([Char], GValue) constructEntryImModule val = constructObjectPropertyString "im-module" val data EntryImModulePropertyInfo instance AttrInfo EntryImModulePropertyInfo where type AttrAllowedOps EntryImModulePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryImModulePropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntryImModulePropertyInfo = EntryK type AttrGetType EntryImModulePropertyInfo = T.Text type AttrLabel EntryImModulePropertyInfo = "Entry::im-module" attrGet _ = getEntryImModule attrSet _ = setEntryImModule attrConstruct _ = constructEntryImModule -- VVV Prop "inner-border" -- Type: TInterface "Gtk" "Border" -- Flags: [PropertyReadable,PropertyWritable] getEntryInnerBorder :: (MonadIO m, EntryK o) => o -> m Border getEntryInnerBorder obj = liftIO $ getObjectPropertyBoxed obj "inner-border" Border setEntryInnerBorder :: (MonadIO m, EntryK o) => o -> Border -> m () setEntryInnerBorder obj val = liftIO $ setObjectPropertyBoxed obj "inner-border" val constructEntryInnerBorder :: Border -> IO ([Char], GValue) constructEntryInnerBorder val = constructObjectPropertyBoxed "inner-border" val data EntryInnerBorderPropertyInfo instance AttrInfo EntryInnerBorderPropertyInfo where type AttrAllowedOps EntryInnerBorderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryInnerBorderPropertyInfo = (~) Border type AttrBaseTypeConstraint EntryInnerBorderPropertyInfo = EntryK type AttrGetType EntryInnerBorderPropertyInfo = Border type AttrLabel EntryInnerBorderPropertyInfo = "Entry::inner-border" attrGet _ = getEntryInnerBorder attrSet _ = setEntryInnerBorder attrConstruct _ = constructEntryInnerBorder -- VVV Prop "input-hints" -- Type: TInterface "Gtk" "InputHints" -- Flags: [PropertyReadable,PropertyWritable] getEntryInputHints :: (MonadIO m, EntryK o) => o -> m [InputHints] getEntryInputHints obj = liftIO $ getObjectPropertyFlags obj "input-hints" setEntryInputHints :: (MonadIO m, EntryK o) => o -> [InputHints] -> m () setEntryInputHints obj val = liftIO $ setObjectPropertyFlags obj "input-hints" val constructEntryInputHints :: [InputHints] -> IO ([Char], GValue) constructEntryInputHints val = constructObjectPropertyFlags "input-hints" val data EntryInputHintsPropertyInfo instance AttrInfo EntryInputHintsPropertyInfo where type AttrAllowedOps EntryInputHintsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryInputHintsPropertyInfo = (~) [InputHints] type AttrBaseTypeConstraint EntryInputHintsPropertyInfo = EntryK type AttrGetType EntryInputHintsPropertyInfo = [InputHints] type AttrLabel EntryInputHintsPropertyInfo = "Entry::input-hints" attrGet _ = getEntryInputHints attrSet _ = setEntryInputHints attrConstruct _ = constructEntryInputHints -- VVV Prop "input-purpose" -- Type: TInterface "Gtk" "InputPurpose" -- Flags: [PropertyReadable,PropertyWritable] getEntryInputPurpose :: (MonadIO m, EntryK o) => o -> m InputPurpose getEntryInputPurpose obj = liftIO $ getObjectPropertyEnum obj "input-purpose" setEntryInputPurpose :: (MonadIO m, EntryK o) => o -> InputPurpose -> m () setEntryInputPurpose obj val = liftIO $ setObjectPropertyEnum obj "input-purpose" val constructEntryInputPurpose :: InputPurpose -> IO ([Char], GValue) constructEntryInputPurpose val = constructObjectPropertyEnum "input-purpose" val data EntryInputPurposePropertyInfo instance AttrInfo EntryInputPurposePropertyInfo where type AttrAllowedOps EntryInputPurposePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryInputPurposePropertyInfo = (~) InputPurpose type AttrBaseTypeConstraint EntryInputPurposePropertyInfo = EntryK type AttrGetType EntryInputPurposePropertyInfo = InputPurpose type AttrLabel EntryInputPurposePropertyInfo = "Entry::input-purpose" attrGet _ = getEntryInputPurpose attrSet _ = setEntryInputPurpose attrConstruct _ = constructEntryInputPurpose -- VVV Prop "invisible-char" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getEntryInvisibleChar :: (MonadIO m, EntryK o) => o -> m Word32 getEntryInvisibleChar obj = liftIO $ getObjectPropertyCUInt obj "invisible-char" setEntryInvisibleChar :: (MonadIO m, EntryK o) => o -> Word32 -> m () setEntryInvisibleChar obj val = liftIO $ setObjectPropertyCUInt obj "invisible-char" val constructEntryInvisibleChar :: Word32 -> IO ([Char], GValue) constructEntryInvisibleChar val = constructObjectPropertyCUInt "invisible-char" val data EntryInvisibleCharPropertyInfo instance AttrInfo EntryInvisibleCharPropertyInfo where type AttrAllowedOps EntryInvisibleCharPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryInvisibleCharPropertyInfo = (~) Word32 type AttrBaseTypeConstraint EntryInvisibleCharPropertyInfo = EntryK type AttrGetType EntryInvisibleCharPropertyInfo = Word32 type AttrLabel EntryInvisibleCharPropertyInfo = "Entry::invisible-char" attrGet _ = getEntryInvisibleChar attrSet _ = setEntryInvisibleChar attrConstruct _ = constructEntryInvisibleChar -- VVV Prop "invisible-char-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryInvisibleCharSet :: (MonadIO m, EntryK o) => o -> m Bool getEntryInvisibleCharSet obj = liftIO $ getObjectPropertyBool obj "invisible-char-set" setEntryInvisibleCharSet :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryInvisibleCharSet obj val = liftIO $ setObjectPropertyBool obj "invisible-char-set" val constructEntryInvisibleCharSet :: Bool -> IO ([Char], GValue) constructEntryInvisibleCharSet val = constructObjectPropertyBool "invisible-char-set" val data EntryInvisibleCharSetPropertyInfo instance AttrInfo EntryInvisibleCharSetPropertyInfo where type AttrAllowedOps EntryInvisibleCharSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryInvisibleCharSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryInvisibleCharSetPropertyInfo = EntryK type AttrGetType EntryInvisibleCharSetPropertyInfo = Bool type AttrLabel EntryInvisibleCharSetPropertyInfo = "Entry::invisible-char-set" attrGet _ = getEntryInvisibleCharSet attrSet _ = setEntryInvisibleCharSet attrConstruct _ = constructEntryInvisibleCharSet -- VVV Prop "max-length" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getEntryMaxLength :: (MonadIO m, EntryK o) => o -> m Int32 getEntryMaxLength obj = liftIO $ getObjectPropertyCInt obj "max-length" setEntryMaxLength :: (MonadIO m, EntryK o) => o -> Int32 -> m () setEntryMaxLength obj val = liftIO $ setObjectPropertyCInt obj "max-length" val constructEntryMaxLength :: Int32 -> IO ([Char], GValue) constructEntryMaxLength val = constructObjectPropertyCInt "max-length" val data EntryMaxLengthPropertyInfo instance AttrInfo EntryMaxLengthPropertyInfo where type AttrAllowedOps EntryMaxLengthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryMaxLengthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint EntryMaxLengthPropertyInfo = EntryK type AttrGetType EntryMaxLengthPropertyInfo = Int32 type AttrLabel EntryMaxLengthPropertyInfo = "Entry::max-length" attrGet _ = getEntryMaxLength attrSet _ = setEntryMaxLength attrConstruct _ = constructEntryMaxLength -- VVV Prop "max-width-chars" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getEntryMaxWidthChars :: (MonadIO m, EntryK o) => o -> m Int32 getEntryMaxWidthChars obj = liftIO $ getObjectPropertyCInt obj "max-width-chars" setEntryMaxWidthChars :: (MonadIO m, EntryK o) => o -> Int32 -> m () setEntryMaxWidthChars obj val = liftIO $ setObjectPropertyCInt obj "max-width-chars" val constructEntryMaxWidthChars :: Int32 -> IO ([Char], GValue) constructEntryMaxWidthChars val = constructObjectPropertyCInt "max-width-chars" val data EntryMaxWidthCharsPropertyInfo instance AttrInfo EntryMaxWidthCharsPropertyInfo where type AttrAllowedOps EntryMaxWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryMaxWidthCharsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint EntryMaxWidthCharsPropertyInfo = EntryK type AttrGetType EntryMaxWidthCharsPropertyInfo = Int32 type AttrLabel EntryMaxWidthCharsPropertyInfo = "Entry::max-width-chars" attrGet _ = getEntryMaxWidthChars attrSet _ = setEntryMaxWidthChars attrConstruct _ = constructEntryMaxWidthChars -- VVV Prop "overwrite-mode" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryOverwriteMode :: (MonadIO m, EntryK o) => o -> m Bool getEntryOverwriteMode obj = liftIO $ getObjectPropertyBool obj "overwrite-mode" setEntryOverwriteMode :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryOverwriteMode obj val = liftIO $ setObjectPropertyBool obj "overwrite-mode" val constructEntryOverwriteMode :: Bool -> IO ([Char], GValue) constructEntryOverwriteMode val = constructObjectPropertyBool "overwrite-mode" val data EntryOverwriteModePropertyInfo instance AttrInfo EntryOverwriteModePropertyInfo where type AttrAllowedOps EntryOverwriteModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryOverwriteModePropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryOverwriteModePropertyInfo = EntryK type AttrGetType EntryOverwriteModePropertyInfo = Bool type AttrLabel EntryOverwriteModePropertyInfo = "Entry::overwrite-mode" attrGet _ = getEntryOverwriteMode attrSet _ = setEntryOverwriteMode attrConstruct _ = constructEntryOverwriteMode -- VVV Prop "placeholder-text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntryPlaceholderText :: (MonadIO m, EntryK o) => o -> m T.Text getEntryPlaceholderText obj = liftIO $ getObjectPropertyString obj "placeholder-text" setEntryPlaceholderText :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntryPlaceholderText obj val = liftIO $ setObjectPropertyString obj "placeholder-text" val constructEntryPlaceholderText :: T.Text -> IO ([Char], GValue) constructEntryPlaceholderText val = constructObjectPropertyString "placeholder-text" val data EntryPlaceholderTextPropertyInfo instance AttrInfo EntryPlaceholderTextPropertyInfo where type AttrAllowedOps EntryPlaceholderTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryPlaceholderTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntryPlaceholderTextPropertyInfo = EntryK type AttrGetType EntryPlaceholderTextPropertyInfo = T.Text type AttrLabel EntryPlaceholderTextPropertyInfo = "Entry::placeholder-text" attrGet _ = getEntryPlaceholderText attrSet _ = setEntryPlaceholderText attrConstruct _ = constructEntryPlaceholderText -- VVV Prop "populate-all" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryPopulateAll :: (MonadIO m, EntryK o) => o -> m Bool getEntryPopulateAll obj = liftIO $ getObjectPropertyBool obj "populate-all" setEntryPopulateAll :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryPopulateAll obj val = liftIO $ setObjectPropertyBool obj "populate-all" val constructEntryPopulateAll :: Bool -> IO ([Char], GValue) constructEntryPopulateAll val = constructObjectPropertyBool "populate-all" val data EntryPopulateAllPropertyInfo instance AttrInfo EntryPopulateAllPropertyInfo where type AttrAllowedOps EntryPopulateAllPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryPopulateAllPropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryPopulateAllPropertyInfo = EntryK type AttrGetType EntryPopulateAllPropertyInfo = Bool type AttrLabel EntryPopulateAllPropertyInfo = "Entry::populate-all" attrGet _ = getEntryPopulateAll attrSet _ = setEntryPopulateAll attrConstruct _ = constructEntryPopulateAll -- VVV Prop "primary-icon-activatable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryPrimaryIconActivatable :: (MonadIO m, EntryK o) => o -> m Bool getEntryPrimaryIconActivatable obj = liftIO $ getObjectPropertyBool obj "primary-icon-activatable" setEntryPrimaryIconActivatable :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryPrimaryIconActivatable obj val = liftIO $ setObjectPropertyBool obj "primary-icon-activatable" val constructEntryPrimaryIconActivatable :: Bool -> IO ([Char], GValue) constructEntryPrimaryIconActivatable val = constructObjectPropertyBool "primary-icon-activatable" val data EntryPrimaryIconActivatablePropertyInfo instance AttrInfo EntryPrimaryIconActivatablePropertyInfo where type AttrAllowedOps EntryPrimaryIconActivatablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryPrimaryIconActivatablePropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryPrimaryIconActivatablePropertyInfo = EntryK type AttrGetType EntryPrimaryIconActivatablePropertyInfo = Bool type AttrLabel EntryPrimaryIconActivatablePropertyInfo = "Entry::primary-icon-activatable" attrGet _ = getEntryPrimaryIconActivatable attrSet _ = setEntryPrimaryIconActivatable attrConstruct _ = constructEntryPrimaryIconActivatable -- VVV Prop "primary-icon-gicon" -- Type: TInterface "Gio" "Icon" -- Flags: [PropertyReadable,PropertyWritable] getEntryPrimaryIconGicon :: (MonadIO m, EntryK o) => o -> m Gio.Icon getEntryPrimaryIconGicon obj = liftIO $ getObjectPropertyObject obj "primary-icon-gicon" Gio.Icon setEntryPrimaryIconGicon :: (MonadIO m, EntryK o, Gio.IconK a) => o -> a -> m () setEntryPrimaryIconGicon obj val = liftIO $ setObjectPropertyObject obj "primary-icon-gicon" val constructEntryPrimaryIconGicon :: (Gio.IconK a) => a -> IO ([Char], GValue) constructEntryPrimaryIconGicon val = constructObjectPropertyObject "primary-icon-gicon" val data EntryPrimaryIconGiconPropertyInfo instance AttrInfo EntryPrimaryIconGiconPropertyInfo where type AttrAllowedOps EntryPrimaryIconGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryPrimaryIconGiconPropertyInfo = Gio.IconK type AttrBaseTypeConstraint EntryPrimaryIconGiconPropertyInfo = EntryK type AttrGetType EntryPrimaryIconGiconPropertyInfo = Gio.Icon type AttrLabel EntryPrimaryIconGiconPropertyInfo = "Entry::primary-icon-gicon" attrGet _ = getEntryPrimaryIconGicon attrSet _ = setEntryPrimaryIconGicon attrConstruct _ = constructEntryPrimaryIconGicon -- VVV Prop "primary-icon-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntryPrimaryIconName :: (MonadIO m, EntryK o) => o -> m T.Text getEntryPrimaryIconName obj = liftIO $ getObjectPropertyString obj "primary-icon-name" setEntryPrimaryIconName :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntryPrimaryIconName obj val = liftIO $ setObjectPropertyString obj "primary-icon-name" val constructEntryPrimaryIconName :: T.Text -> IO ([Char], GValue) constructEntryPrimaryIconName val = constructObjectPropertyString "primary-icon-name" val data EntryPrimaryIconNamePropertyInfo instance AttrInfo EntryPrimaryIconNamePropertyInfo where type AttrAllowedOps EntryPrimaryIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryPrimaryIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntryPrimaryIconNamePropertyInfo = EntryK type AttrGetType EntryPrimaryIconNamePropertyInfo = T.Text type AttrLabel EntryPrimaryIconNamePropertyInfo = "Entry::primary-icon-name" attrGet _ = getEntryPrimaryIconName attrSet _ = setEntryPrimaryIconName attrConstruct _ = constructEntryPrimaryIconName -- VVV Prop "primary-icon-pixbuf" -- Type: TInterface "GdkPixbuf" "Pixbuf" -- Flags: [PropertyReadable,PropertyWritable] getEntryPrimaryIconPixbuf :: (MonadIO m, EntryK o) => o -> m GdkPixbuf.Pixbuf getEntryPrimaryIconPixbuf obj = liftIO $ getObjectPropertyObject obj "primary-icon-pixbuf" GdkPixbuf.Pixbuf setEntryPrimaryIconPixbuf :: (MonadIO m, EntryK o, GdkPixbuf.PixbufK a) => o -> a -> m () setEntryPrimaryIconPixbuf obj val = liftIO $ setObjectPropertyObject obj "primary-icon-pixbuf" val constructEntryPrimaryIconPixbuf :: (GdkPixbuf.PixbufK a) => a -> IO ([Char], GValue) constructEntryPrimaryIconPixbuf val = constructObjectPropertyObject "primary-icon-pixbuf" val data EntryPrimaryIconPixbufPropertyInfo instance AttrInfo EntryPrimaryIconPixbufPropertyInfo where type AttrAllowedOps EntryPrimaryIconPixbufPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryPrimaryIconPixbufPropertyInfo = GdkPixbuf.PixbufK type AttrBaseTypeConstraint EntryPrimaryIconPixbufPropertyInfo = EntryK type AttrGetType EntryPrimaryIconPixbufPropertyInfo = GdkPixbuf.Pixbuf type AttrLabel EntryPrimaryIconPixbufPropertyInfo = "Entry::primary-icon-pixbuf" attrGet _ = getEntryPrimaryIconPixbuf attrSet _ = setEntryPrimaryIconPixbuf attrConstruct _ = constructEntryPrimaryIconPixbuf -- VVV Prop "primary-icon-sensitive" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryPrimaryIconSensitive :: (MonadIO m, EntryK o) => o -> m Bool getEntryPrimaryIconSensitive obj = liftIO $ getObjectPropertyBool obj "primary-icon-sensitive" setEntryPrimaryIconSensitive :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryPrimaryIconSensitive obj val = liftIO $ setObjectPropertyBool obj "primary-icon-sensitive" val constructEntryPrimaryIconSensitive :: Bool -> IO ([Char], GValue) constructEntryPrimaryIconSensitive val = constructObjectPropertyBool "primary-icon-sensitive" val data EntryPrimaryIconSensitivePropertyInfo instance AttrInfo EntryPrimaryIconSensitivePropertyInfo where type AttrAllowedOps EntryPrimaryIconSensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryPrimaryIconSensitivePropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryPrimaryIconSensitivePropertyInfo = EntryK type AttrGetType EntryPrimaryIconSensitivePropertyInfo = Bool type AttrLabel EntryPrimaryIconSensitivePropertyInfo = "Entry::primary-icon-sensitive" attrGet _ = getEntryPrimaryIconSensitive attrSet _ = setEntryPrimaryIconSensitive attrConstruct _ = constructEntryPrimaryIconSensitive -- VVV Prop "primary-icon-stock" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntryPrimaryIconStock :: (MonadIO m, EntryK o) => o -> m T.Text getEntryPrimaryIconStock obj = liftIO $ getObjectPropertyString obj "primary-icon-stock" setEntryPrimaryIconStock :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntryPrimaryIconStock obj val = liftIO $ setObjectPropertyString obj "primary-icon-stock" val constructEntryPrimaryIconStock :: T.Text -> IO ([Char], GValue) constructEntryPrimaryIconStock val = constructObjectPropertyString "primary-icon-stock" val data EntryPrimaryIconStockPropertyInfo instance AttrInfo EntryPrimaryIconStockPropertyInfo where type AttrAllowedOps EntryPrimaryIconStockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryPrimaryIconStockPropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntryPrimaryIconStockPropertyInfo = EntryK type AttrGetType EntryPrimaryIconStockPropertyInfo = T.Text type AttrLabel EntryPrimaryIconStockPropertyInfo = "Entry::primary-icon-stock" attrGet _ = getEntryPrimaryIconStock attrSet _ = setEntryPrimaryIconStock attrConstruct _ = constructEntryPrimaryIconStock -- VVV Prop "primary-icon-storage-type" -- Type: TInterface "Gtk" "ImageType" -- Flags: [PropertyReadable] getEntryPrimaryIconStorageType :: (MonadIO m, EntryK o) => o -> m ImageType getEntryPrimaryIconStorageType obj = liftIO $ getObjectPropertyEnum obj "primary-icon-storage-type" data EntryPrimaryIconStorageTypePropertyInfo instance AttrInfo EntryPrimaryIconStorageTypePropertyInfo where type AttrAllowedOps EntryPrimaryIconStorageTypePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint EntryPrimaryIconStorageTypePropertyInfo = (~) () type AttrBaseTypeConstraint EntryPrimaryIconStorageTypePropertyInfo = EntryK type AttrGetType EntryPrimaryIconStorageTypePropertyInfo = ImageType type AttrLabel EntryPrimaryIconStorageTypePropertyInfo = "Entry::primary-icon-storage-type" attrGet _ = getEntryPrimaryIconStorageType attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "primary-icon-tooltip-markup" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntryPrimaryIconTooltipMarkup :: (MonadIO m, EntryK o) => o -> m T.Text getEntryPrimaryIconTooltipMarkup obj = liftIO $ getObjectPropertyString obj "primary-icon-tooltip-markup" setEntryPrimaryIconTooltipMarkup :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntryPrimaryIconTooltipMarkup obj val = liftIO $ setObjectPropertyString obj "primary-icon-tooltip-markup" val constructEntryPrimaryIconTooltipMarkup :: T.Text -> IO ([Char], GValue) constructEntryPrimaryIconTooltipMarkup val = constructObjectPropertyString "primary-icon-tooltip-markup" val data EntryPrimaryIconTooltipMarkupPropertyInfo instance AttrInfo EntryPrimaryIconTooltipMarkupPropertyInfo where type AttrAllowedOps EntryPrimaryIconTooltipMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryPrimaryIconTooltipMarkupPropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntryPrimaryIconTooltipMarkupPropertyInfo = EntryK type AttrGetType EntryPrimaryIconTooltipMarkupPropertyInfo = T.Text type AttrLabel EntryPrimaryIconTooltipMarkupPropertyInfo = "Entry::primary-icon-tooltip-markup" attrGet _ = getEntryPrimaryIconTooltipMarkup attrSet _ = setEntryPrimaryIconTooltipMarkup attrConstruct _ = constructEntryPrimaryIconTooltipMarkup -- VVV Prop "primary-icon-tooltip-text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntryPrimaryIconTooltipText :: (MonadIO m, EntryK o) => o -> m T.Text getEntryPrimaryIconTooltipText obj = liftIO $ getObjectPropertyString obj "primary-icon-tooltip-text" setEntryPrimaryIconTooltipText :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntryPrimaryIconTooltipText obj val = liftIO $ setObjectPropertyString obj "primary-icon-tooltip-text" val constructEntryPrimaryIconTooltipText :: T.Text -> IO ([Char], GValue) constructEntryPrimaryIconTooltipText val = constructObjectPropertyString "primary-icon-tooltip-text" val data EntryPrimaryIconTooltipTextPropertyInfo instance AttrInfo EntryPrimaryIconTooltipTextPropertyInfo where type AttrAllowedOps EntryPrimaryIconTooltipTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryPrimaryIconTooltipTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntryPrimaryIconTooltipTextPropertyInfo = EntryK type AttrGetType EntryPrimaryIconTooltipTextPropertyInfo = T.Text type AttrLabel EntryPrimaryIconTooltipTextPropertyInfo = "Entry::primary-icon-tooltip-text" attrGet _ = getEntryPrimaryIconTooltipText attrSet _ = setEntryPrimaryIconTooltipText attrConstruct _ = constructEntryPrimaryIconTooltipText -- VVV Prop "progress-fraction" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getEntryProgressFraction :: (MonadIO m, EntryK o) => o -> m Double getEntryProgressFraction obj = liftIO $ getObjectPropertyDouble obj "progress-fraction" setEntryProgressFraction :: (MonadIO m, EntryK o) => o -> Double -> m () setEntryProgressFraction obj val = liftIO $ setObjectPropertyDouble obj "progress-fraction" val constructEntryProgressFraction :: Double -> IO ([Char], GValue) constructEntryProgressFraction val = constructObjectPropertyDouble "progress-fraction" val data EntryProgressFractionPropertyInfo instance AttrInfo EntryProgressFractionPropertyInfo where type AttrAllowedOps EntryProgressFractionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryProgressFractionPropertyInfo = (~) Double type AttrBaseTypeConstraint EntryProgressFractionPropertyInfo = EntryK type AttrGetType EntryProgressFractionPropertyInfo = Double type AttrLabel EntryProgressFractionPropertyInfo = "Entry::progress-fraction" attrGet _ = getEntryProgressFraction attrSet _ = setEntryProgressFraction attrConstruct _ = constructEntryProgressFraction -- VVV Prop "progress-pulse-step" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getEntryProgressPulseStep :: (MonadIO m, EntryK o) => o -> m Double getEntryProgressPulseStep obj = liftIO $ getObjectPropertyDouble obj "progress-pulse-step" setEntryProgressPulseStep :: (MonadIO m, EntryK o) => o -> Double -> m () setEntryProgressPulseStep obj val = liftIO $ setObjectPropertyDouble obj "progress-pulse-step" val constructEntryProgressPulseStep :: Double -> IO ([Char], GValue) constructEntryProgressPulseStep val = constructObjectPropertyDouble "progress-pulse-step" val data EntryProgressPulseStepPropertyInfo instance AttrInfo EntryProgressPulseStepPropertyInfo where type AttrAllowedOps EntryProgressPulseStepPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryProgressPulseStepPropertyInfo = (~) Double type AttrBaseTypeConstraint EntryProgressPulseStepPropertyInfo = EntryK type AttrGetType EntryProgressPulseStepPropertyInfo = Double type AttrLabel EntryProgressPulseStepPropertyInfo = "Entry::progress-pulse-step" attrGet _ = getEntryProgressPulseStep attrSet _ = setEntryProgressPulseStep attrConstruct _ = constructEntryProgressPulseStep -- VVV Prop "scroll-offset" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getEntryScrollOffset :: (MonadIO m, EntryK o) => o -> m Int32 getEntryScrollOffset obj = liftIO $ getObjectPropertyCInt obj "scroll-offset" data EntryScrollOffsetPropertyInfo instance AttrInfo EntryScrollOffsetPropertyInfo where type AttrAllowedOps EntryScrollOffsetPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint EntryScrollOffsetPropertyInfo = (~) () type AttrBaseTypeConstraint EntryScrollOffsetPropertyInfo = EntryK type AttrGetType EntryScrollOffsetPropertyInfo = Int32 type AttrLabel EntryScrollOffsetPropertyInfo = "Entry::scroll-offset" attrGet _ = getEntryScrollOffset attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "secondary-icon-activatable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntrySecondaryIconActivatable :: (MonadIO m, EntryK o) => o -> m Bool getEntrySecondaryIconActivatable obj = liftIO $ getObjectPropertyBool obj "secondary-icon-activatable" setEntrySecondaryIconActivatable :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntrySecondaryIconActivatable obj val = liftIO $ setObjectPropertyBool obj "secondary-icon-activatable" val constructEntrySecondaryIconActivatable :: Bool -> IO ([Char], GValue) constructEntrySecondaryIconActivatable val = constructObjectPropertyBool "secondary-icon-activatable" val data EntrySecondaryIconActivatablePropertyInfo instance AttrInfo EntrySecondaryIconActivatablePropertyInfo where type AttrAllowedOps EntrySecondaryIconActivatablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntrySecondaryIconActivatablePropertyInfo = (~) Bool type AttrBaseTypeConstraint EntrySecondaryIconActivatablePropertyInfo = EntryK type AttrGetType EntrySecondaryIconActivatablePropertyInfo = Bool type AttrLabel EntrySecondaryIconActivatablePropertyInfo = "Entry::secondary-icon-activatable" attrGet _ = getEntrySecondaryIconActivatable attrSet _ = setEntrySecondaryIconActivatable attrConstruct _ = constructEntrySecondaryIconActivatable -- VVV Prop "secondary-icon-gicon" -- Type: TInterface "Gio" "Icon" -- Flags: [PropertyReadable,PropertyWritable] getEntrySecondaryIconGicon :: (MonadIO m, EntryK o) => o -> m Gio.Icon getEntrySecondaryIconGicon obj = liftIO $ getObjectPropertyObject obj "secondary-icon-gicon" Gio.Icon setEntrySecondaryIconGicon :: (MonadIO m, EntryK o, Gio.IconK a) => o -> a -> m () setEntrySecondaryIconGicon obj val = liftIO $ setObjectPropertyObject obj "secondary-icon-gicon" val constructEntrySecondaryIconGicon :: (Gio.IconK a) => a -> IO ([Char], GValue) constructEntrySecondaryIconGicon val = constructObjectPropertyObject "secondary-icon-gicon" val data EntrySecondaryIconGiconPropertyInfo instance AttrInfo EntrySecondaryIconGiconPropertyInfo where type AttrAllowedOps EntrySecondaryIconGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntrySecondaryIconGiconPropertyInfo = Gio.IconK type AttrBaseTypeConstraint EntrySecondaryIconGiconPropertyInfo = EntryK type AttrGetType EntrySecondaryIconGiconPropertyInfo = Gio.Icon type AttrLabel EntrySecondaryIconGiconPropertyInfo = "Entry::secondary-icon-gicon" attrGet _ = getEntrySecondaryIconGicon attrSet _ = setEntrySecondaryIconGicon attrConstruct _ = constructEntrySecondaryIconGicon -- VVV Prop "secondary-icon-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntrySecondaryIconName :: (MonadIO m, EntryK o) => o -> m T.Text getEntrySecondaryIconName obj = liftIO $ getObjectPropertyString obj "secondary-icon-name" setEntrySecondaryIconName :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntrySecondaryIconName obj val = liftIO $ setObjectPropertyString obj "secondary-icon-name" val constructEntrySecondaryIconName :: T.Text -> IO ([Char], GValue) constructEntrySecondaryIconName val = constructObjectPropertyString "secondary-icon-name" val data EntrySecondaryIconNamePropertyInfo instance AttrInfo EntrySecondaryIconNamePropertyInfo where type AttrAllowedOps EntrySecondaryIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntrySecondaryIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntrySecondaryIconNamePropertyInfo = EntryK type AttrGetType EntrySecondaryIconNamePropertyInfo = T.Text type AttrLabel EntrySecondaryIconNamePropertyInfo = "Entry::secondary-icon-name" attrGet _ = getEntrySecondaryIconName attrSet _ = setEntrySecondaryIconName attrConstruct _ = constructEntrySecondaryIconName -- VVV Prop "secondary-icon-pixbuf" -- Type: TInterface "GdkPixbuf" "Pixbuf" -- Flags: [PropertyReadable,PropertyWritable] getEntrySecondaryIconPixbuf :: (MonadIO m, EntryK o) => o -> m GdkPixbuf.Pixbuf getEntrySecondaryIconPixbuf obj = liftIO $ getObjectPropertyObject obj "secondary-icon-pixbuf" GdkPixbuf.Pixbuf setEntrySecondaryIconPixbuf :: (MonadIO m, EntryK o, GdkPixbuf.PixbufK a) => o -> a -> m () setEntrySecondaryIconPixbuf obj val = liftIO $ setObjectPropertyObject obj "secondary-icon-pixbuf" val constructEntrySecondaryIconPixbuf :: (GdkPixbuf.PixbufK a) => a -> IO ([Char], GValue) constructEntrySecondaryIconPixbuf val = constructObjectPropertyObject "secondary-icon-pixbuf" val data EntrySecondaryIconPixbufPropertyInfo instance AttrInfo EntrySecondaryIconPixbufPropertyInfo where type AttrAllowedOps EntrySecondaryIconPixbufPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntrySecondaryIconPixbufPropertyInfo = GdkPixbuf.PixbufK type AttrBaseTypeConstraint EntrySecondaryIconPixbufPropertyInfo = EntryK type AttrGetType EntrySecondaryIconPixbufPropertyInfo = GdkPixbuf.Pixbuf type AttrLabel EntrySecondaryIconPixbufPropertyInfo = "Entry::secondary-icon-pixbuf" attrGet _ = getEntrySecondaryIconPixbuf attrSet _ = setEntrySecondaryIconPixbuf attrConstruct _ = constructEntrySecondaryIconPixbuf -- VVV Prop "secondary-icon-sensitive" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntrySecondaryIconSensitive :: (MonadIO m, EntryK o) => o -> m Bool getEntrySecondaryIconSensitive obj = liftIO $ getObjectPropertyBool obj "secondary-icon-sensitive" setEntrySecondaryIconSensitive :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntrySecondaryIconSensitive obj val = liftIO $ setObjectPropertyBool obj "secondary-icon-sensitive" val constructEntrySecondaryIconSensitive :: Bool -> IO ([Char], GValue) constructEntrySecondaryIconSensitive val = constructObjectPropertyBool "secondary-icon-sensitive" val data EntrySecondaryIconSensitivePropertyInfo instance AttrInfo EntrySecondaryIconSensitivePropertyInfo where type AttrAllowedOps EntrySecondaryIconSensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntrySecondaryIconSensitivePropertyInfo = (~) Bool type AttrBaseTypeConstraint EntrySecondaryIconSensitivePropertyInfo = EntryK type AttrGetType EntrySecondaryIconSensitivePropertyInfo = Bool type AttrLabel EntrySecondaryIconSensitivePropertyInfo = "Entry::secondary-icon-sensitive" attrGet _ = getEntrySecondaryIconSensitive attrSet _ = setEntrySecondaryIconSensitive attrConstruct _ = constructEntrySecondaryIconSensitive -- VVV Prop "secondary-icon-stock" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntrySecondaryIconStock :: (MonadIO m, EntryK o) => o -> m T.Text getEntrySecondaryIconStock obj = liftIO $ getObjectPropertyString obj "secondary-icon-stock" setEntrySecondaryIconStock :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntrySecondaryIconStock obj val = liftIO $ setObjectPropertyString obj "secondary-icon-stock" val constructEntrySecondaryIconStock :: T.Text -> IO ([Char], GValue) constructEntrySecondaryIconStock val = constructObjectPropertyString "secondary-icon-stock" val data EntrySecondaryIconStockPropertyInfo instance AttrInfo EntrySecondaryIconStockPropertyInfo where type AttrAllowedOps EntrySecondaryIconStockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntrySecondaryIconStockPropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntrySecondaryIconStockPropertyInfo = EntryK type AttrGetType EntrySecondaryIconStockPropertyInfo = T.Text type AttrLabel EntrySecondaryIconStockPropertyInfo = "Entry::secondary-icon-stock" attrGet _ = getEntrySecondaryIconStock attrSet _ = setEntrySecondaryIconStock attrConstruct _ = constructEntrySecondaryIconStock -- VVV Prop "secondary-icon-storage-type" -- Type: TInterface "Gtk" "ImageType" -- Flags: [PropertyReadable] getEntrySecondaryIconStorageType :: (MonadIO m, EntryK o) => o -> m ImageType getEntrySecondaryIconStorageType obj = liftIO $ getObjectPropertyEnum obj "secondary-icon-storage-type" data EntrySecondaryIconStorageTypePropertyInfo instance AttrInfo EntrySecondaryIconStorageTypePropertyInfo where type AttrAllowedOps EntrySecondaryIconStorageTypePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint EntrySecondaryIconStorageTypePropertyInfo = (~) () type AttrBaseTypeConstraint EntrySecondaryIconStorageTypePropertyInfo = EntryK type AttrGetType EntrySecondaryIconStorageTypePropertyInfo = ImageType type AttrLabel EntrySecondaryIconStorageTypePropertyInfo = "Entry::secondary-icon-storage-type" attrGet _ = getEntrySecondaryIconStorageType attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "secondary-icon-tooltip-markup" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntrySecondaryIconTooltipMarkup :: (MonadIO m, EntryK o) => o -> m T.Text getEntrySecondaryIconTooltipMarkup obj = liftIO $ getObjectPropertyString obj "secondary-icon-tooltip-markup" setEntrySecondaryIconTooltipMarkup :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntrySecondaryIconTooltipMarkup obj val = liftIO $ setObjectPropertyString obj "secondary-icon-tooltip-markup" val constructEntrySecondaryIconTooltipMarkup :: T.Text -> IO ([Char], GValue) constructEntrySecondaryIconTooltipMarkup val = constructObjectPropertyString "secondary-icon-tooltip-markup" val data EntrySecondaryIconTooltipMarkupPropertyInfo instance AttrInfo EntrySecondaryIconTooltipMarkupPropertyInfo where type AttrAllowedOps EntrySecondaryIconTooltipMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntrySecondaryIconTooltipMarkupPropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntrySecondaryIconTooltipMarkupPropertyInfo = EntryK type AttrGetType EntrySecondaryIconTooltipMarkupPropertyInfo = T.Text type AttrLabel EntrySecondaryIconTooltipMarkupPropertyInfo = "Entry::secondary-icon-tooltip-markup" attrGet _ = getEntrySecondaryIconTooltipMarkup attrSet _ = setEntrySecondaryIconTooltipMarkup attrConstruct _ = constructEntrySecondaryIconTooltipMarkup -- VVV Prop "secondary-icon-tooltip-text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntrySecondaryIconTooltipText :: (MonadIO m, EntryK o) => o -> m T.Text getEntrySecondaryIconTooltipText obj = liftIO $ getObjectPropertyString obj "secondary-icon-tooltip-text" setEntrySecondaryIconTooltipText :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntrySecondaryIconTooltipText obj val = liftIO $ setObjectPropertyString obj "secondary-icon-tooltip-text" val constructEntrySecondaryIconTooltipText :: T.Text -> IO ([Char], GValue) constructEntrySecondaryIconTooltipText val = constructObjectPropertyString "secondary-icon-tooltip-text" val data EntrySecondaryIconTooltipTextPropertyInfo instance AttrInfo EntrySecondaryIconTooltipTextPropertyInfo where type AttrAllowedOps EntrySecondaryIconTooltipTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntrySecondaryIconTooltipTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntrySecondaryIconTooltipTextPropertyInfo = EntryK type AttrGetType EntrySecondaryIconTooltipTextPropertyInfo = T.Text type AttrLabel EntrySecondaryIconTooltipTextPropertyInfo = "Entry::secondary-icon-tooltip-text" attrGet _ = getEntrySecondaryIconTooltipText attrSet _ = setEntrySecondaryIconTooltipText attrConstruct _ = constructEntrySecondaryIconTooltipText -- VVV Prop "selection-bound" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getEntrySelectionBound :: (MonadIO m, EntryK o) => o -> m Int32 getEntrySelectionBound obj = liftIO $ getObjectPropertyCInt obj "selection-bound" data EntrySelectionBoundPropertyInfo instance AttrInfo EntrySelectionBoundPropertyInfo where type AttrAllowedOps EntrySelectionBoundPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint EntrySelectionBoundPropertyInfo = (~) () type AttrBaseTypeConstraint EntrySelectionBoundPropertyInfo = EntryK type AttrGetType EntrySelectionBoundPropertyInfo = Int32 type AttrLabel EntrySelectionBoundPropertyInfo = "Entry::selection-bound" attrGet _ = getEntrySelectionBound attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "shadow-type" -- Type: TInterface "Gtk" "ShadowType" -- Flags: [PropertyReadable,PropertyWritable] getEntryShadowType :: (MonadIO m, EntryK o) => o -> m ShadowType getEntryShadowType obj = liftIO $ getObjectPropertyEnum obj "shadow-type" setEntryShadowType :: (MonadIO m, EntryK o) => o -> ShadowType -> m () setEntryShadowType obj val = liftIO $ setObjectPropertyEnum obj "shadow-type" val constructEntryShadowType :: ShadowType -> IO ([Char], GValue) constructEntryShadowType val = constructObjectPropertyEnum "shadow-type" val data EntryShadowTypePropertyInfo instance AttrInfo EntryShadowTypePropertyInfo where type AttrAllowedOps EntryShadowTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryShadowTypePropertyInfo = (~) ShadowType type AttrBaseTypeConstraint EntryShadowTypePropertyInfo = EntryK type AttrGetType EntryShadowTypePropertyInfo = ShadowType type AttrLabel EntryShadowTypePropertyInfo = "Entry::shadow-type" attrGet _ = getEntryShadowType attrSet _ = setEntryShadowType attrConstruct _ = constructEntryShadowType -- VVV Prop "tabs" -- Type: TInterface "Pango" "TabArray" -- Flags: [PropertyReadable,PropertyWritable] getEntryTabs :: (MonadIO m, EntryK o) => o -> m Pango.TabArray getEntryTabs obj = liftIO $ getObjectPropertyBoxed obj "tabs" Pango.TabArray setEntryTabs :: (MonadIO m, EntryK o) => o -> Pango.TabArray -> m () setEntryTabs obj val = liftIO $ setObjectPropertyBoxed obj "tabs" val constructEntryTabs :: Pango.TabArray -> IO ([Char], GValue) constructEntryTabs val = constructObjectPropertyBoxed "tabs" val data EntryTabsPropertyInfo instance AttrInfo EntryTabsPropertyInfo where type AttrAllowedOps EntryTabsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryTabsPropertyInfo = (~) Pango.TabArray type AttrBaseTypeConstraint EntryTabsPropertyInfo = EntryK type AttrGetType EntryTabsPropertyInfo = Pango.TabArray type AttrLabel EntryTabsPropertyInfo = "Entry::tabs" attrGet _ = getEntryTabs attrSet _ = setEntryTabs attrConstruct _ = constructEntryTabs -- VVV Prop "text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntryText :: (MonadIO m, EntryK o) => o -> m T.Text getEntryText obj = liftIO $ getObjectPropertyString obj "text" setEntryText :: (MonadIO m, EntryK o) => o -> T.Text -> m () setEntryText obj val = liftIO $ setObjectPropertyString obj "text" val constructEntryText :: T.Text -> IO ([Char], GValue) constructEntryText val = constructObjectPropertyString "text" val data EntryTextPropertyInfo instance AttrInfo EntryTextPropertyInfo where type AttrAllowedOps EntryTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntryTextPropertyInfo = EntryK type AttrGetType EntryTextPropertyInfo = T.Text type AttrLabel EntryTextPropertyInfo = "Entry::text" attrGet _ = getEntryText attrSet _ = setEntryText attrConstruct _ = constructEntryText -- VVV Prop "text-length" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable] getEntryTextLength :: (MonadIO m, EntryK o) => o -> m Word32 getEntryTextLength obj = liftIO $ getObjectPropertyCUInt obj "text-length" data EntryTextLengthPropertyInfo instance AttrInfo EntryTextLengthPropertyInfo where type AttrAllowedOps EntryTextLengthPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint EntryTextLengthPropertyInfo = (~) () type AttrBaseTypeConstraint EntryTextLengthPropertyInfo = EntryK type AttrGetType EntryTextLengthPropertyInfo = Word32 type AttrLabel EntryTextLengthPropertyInfo = "Entry::text-length" attrGet _ = getEntryTextLength attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "truncate-multiline" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryTruncateMultiline :: (MonadIO m, EntryK o) => o -> m Bool getEntryTruncateMultiline obj = liftIO $ getObjectPropertyBool obj "truncate-multiline" setEntryTruncateMultiline :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryTruncateMultiline obj val = liftIO $ setObjectPropertyBool obj "truncate-multiline" val constructEntryTruncateMultiline :: Bool -> IO ([Char], GValue) constructEntryTruncateMultiline val = constructObjectPropertyBool "truncate-multiline" val data EntryTruncateMultilinePropertyInfo instance AttrInfo EntryTruncateMultilinePropertyInfo where type AttrAllowedOps EntryTruncateMultilinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryTruncateMultilinePropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryTruncateMultilinePropertyInfo = EntryK type AttrGetType EntryTruncateMultilinePropertyInfo = Bool type AttrLabel EntryTruncateMultilinePropertyInfo = "Entry::truncate-multiline" attrGet _ = getEntryTruncateMultiline attrSet _ = setEntryTruncateMultiline attrConstruct _ = constructEntryTruncateMultiline -- VVV Prop "visibility" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryVisibility :: (MonadIO m, EntryK o) => o -> m Bool getEntryVisibility obj = liftIO $ getObjectPropertyBool obj "visibility" setEntryVisibility :: (MonadIO m, EntryK o) => o -> Bool -> m () setEntryVisibility obj val = liftIO $ setObjectPropertyBool obj "visibility" val constructEntryVisibility :: Bool -> IO ([Char], GValue) constructEntryVisibility val = constructObjectPropertyBool "visibility" val data EntryVisibilityPropertyInfo instance AttrInfo EntryVisibilityPropertyInfo where type AttrAllowedOps EntryVisibilityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryVisibilityPropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryVisibilityPropertyInfo = EntryK type AttrGetType EntryVisibilityPropertyInfo = Bool type AttrLabel EntryVisibilityPropertyInfo = "Entry::visibility" attrGet _ = getEntryVisibility attrSet _ = setEntryVisibility attrConstruct _ = constructEntryVisibility -- VVV Prop "width-chars" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getEntryWidthChars :: (MonadIO m, EntryK o) => o -> m Int32 getEntryWidthChars obj = liftIO $ getObjectPropertyCInt obj "width-chars" setEntryWidthChars :: (MonadIO m, EntryK o) => o -> Int32 -> m () setEntryWidthChars obj val = liftIO $ setObjectPropertyCInt obj "width-chars" val constructEntryWidthChars :: Int32 -> IO ([Char], GValue) constructEntryWidthChars val = constructObjectPropertyCInt "width-chars" val data EntryWidthCharsPropertyInfo instance AttrInfo EntryWidthCharsPropertyInfo where type AttrAllowedOps EntryWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryWidthCharsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint EntryWidthCharsPropertyInfo = EntryK type AttrGetType EntryWidthCharsPropertyInfo = Int32 type AttrLabel EntryWidthCharsPropertyInfo = "Entry::width-chars" attrGet _ = getEntryWidthChars attrSet _ = setEntryWidthChars attrConstruct _ = constructEntryWidthChars -- VVV Prop "xalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getEntryXalign :: (MonadIO m, EntryK o) => o -> m Float getEntryXalign obj = liftIO $ getObjectPropertyFloat obj "xalign" setEntryXalign :: (MonadIO m, EntryK o) => o -> Float -> m () setEntryXalign obj val = liftIO $ setObjectPropertyFloat obj "xalign" val constructEntryXalign :: Float -> IO ([Char], GValue) constructEntryXalign val = constructObjectPropertyFloat "xalign" val data EntryXalignPropertyInfo instance AttrInfo EntryXalignPropertyInfo where type AttrAllowedOps EntryXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryXalignPropertyInfo = (~) Float type AttrBaseTypeConstraint EntryXalignPropertyInfo = EntryK type AttrGetType EntryXalignPropertyInfo = Float type AttrLabel EntryXalignPropertyInfo = "Entry::xalign" attrGet _ = getEntryXalign attrSet _ = setEntryXalign attrConstruct _ = constructEntryXalign type instance AttributeList Entry = '[ '("activates-default", EntryActivatesDefaultPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("attributes", EntryAttributesPropertyInfo), '("buffer", EntryBufferPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("caps-lock-warning", EntryCapsLockWarningPropertyInfo), '("completion", EntryCompletionPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("cursor-position", EntryCursorPositionPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("editable", EntryEditablePropertyInfo), '("editing-canceled", CellEditableEditingCanceledPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-frame", EntryHasFramePropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("im-module", EntryImModulePropertyInfo), '("inner-border", EntryInnerBorderPropertyInfo), '("input-hints", EntryInputHintsPropertyInfo), '("input-purpose", EntryInputPurposePropertyInfo), '("invisible-char", EntryInvisibleCharPropertyInfo), '("invisible-char-set", EntryInvisibleCharSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-length", EntryMaxLengthPropertyInfo), '("max-width-chars", EntryMaxWidthCharsPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("overwrite-mode", EntryOverwriteModePropertyInfo), '("parent", WidgetParentPropertyInfo), '("placeholder-text", EntryPlaceholderTextPropertyInfo), '("populate-all", EntryPopulateAllPropertyInfo), '("primary-icon-activatable", EntryPrimaryIconActivatablePropertyInfo), '("primary-icon-gicon", EntryPrimaryIconGiconPropertyInfo), '("primary-icon-name", EntryPrimaryIconNamePropertyInfo), '("primary-icon-pixbuf", EntryPrimaryIconPixbufPropertyInfo), '("primary-icon-sensitive", EntryPrimaryIconSensitivePropertyInfo), '("primary-icon-stock", EntryPrimaryIconStockPropertyInfo), '("primary-icon-storage-type", EntryPrimaryIconStorageTypePropertyInfo), '("primary-icon-tooltip-markup", EntryPrimaryIconTooltipMarkupPropertyInfo), '("primary-icon-tooltip-text", EntryPrimaryIconTooltipTextPropertyInfo), '("progress-fraction", EntryProgressFractionPropertyInfo), '("progress-pulse-step", EntryProgressPulseStepPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("scroll-offset", EntryScrollOffsetPropertyInfo), '("secondary-icon-activatable", EntrySecondaryIconActivatablePropertyInfo), '("secondary-icon-gicon", EntrySecondaryIconGiconPropertyInfo), '("secondary-icon-name", EntrySecondaryIconNamePropertyInfo), '("secondary-icon-pixbuf", EntrySecondaryIconPixbufPropertyInfo), '("secondary-icon-sensitive", EntrySecondaryIconSensitivePropertyInfo), '("secondary-icon-stock", EntrySecondaryIconStockPropertyInfo), '("secondary-icon-storage-type", EntrySecondaryIconStorageTypePropertyInfo), '("secondary-icon-tooltip-markup", EntrySecondaryIconTooltipMarkupPropertyInfo), '("secondary-icon-tooltip-text", EntrySecondaryIconTooltipTextPropertyInfo), '("selection-bound", EntrySelectionBoundPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", EntryShadowTypePropertyInfo), '("style", WidgetStylePropertyInfo), '("tabs", EntryTabsPropertyInfo), '("text", EntryTextPropertyInfo), '("text-length", EntryTextLengthPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("truncate-multiline", EntryTruncateMultilinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visibility", EntryVisibilityPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-chars", EntryWidthCharsPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", EntryXalignPropertyInfo)] type instance AttributeList EntryAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "length" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable] getEntryBufferLength :: (MonadIO m, EntryBufferK o) => o -> m Word32 getEntryBufferLength obj = liftIO $ getObjectPropertyCUInt obj "length" data EntryBufferLengthPropertyInfo instance AttrInfo EntryBufferLengthPropertyInfo where type AttrAllowedOps EntryBufferLengthPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint EntryBufferLengthPropertyInfo = (~) () type AttrBaseTypeConstraint EntryBufferLengthPropertyInfo = EntryBufferK type AttrGetType EntryBufferLengthPropertyInfo = Word32 type AttrLabel EntryBufferLengthPropertyInfo = "EntryBuffer::length" attrGet _ = getEntryBufferLength attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "max-length" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getEntryBufferMaxLength :: (MonadIO m, EntryBufferK o) => o -> m Int32 getEntryBufferMaxLength obj = liftIO $ getObjectPropertyCInt obj "max-length" setEntryBufferMaxLength :: (MonadIO m, EntryBufferK o) => o -> Int32 -> m () setEntryBufferMaxLength obj val = liftIO $ setObjectPropertyCInt obj "max-length" val constructEntryBufferMaxLength :: Int32 -> IO ([Char], GValue) constructEntryBufferMaxLength val = constructObjectPropertyCInt "max-length" val data EntryBufferMaxLengthPropertyInfo instance AttrInfo EntryBufferMaxLengthPropertyInfo where type AttrAllowedOps EntryBufferMaxLengthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryBufferMaxLengthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint EntryBufferMaxLengthPropertyInfo = EntryBufferK type AttrGetType EntryBufferMaxLengthPropertyInfo = Int32 type AttrLabel EntryBufferMaxLengthPropertyInfo = "EntryBuffer::max-length" attrGet _ = getEntryBufferMaxLength attrSet _ = setEntryBufferMaxLength attrConstruct _ = constructEntryBufferMaxLength -- VVV Prop "text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getEntryBufferText :: (MonadIO m, EntryBufferK o) => o -> m T.Text getEntryBufferText obj = liftIO $ getObjectPropertyString obj "text" setEntryBufferText :: (MonadIO m, EntryBufferK o) => o -> T.Text -> m () setEntryBufferText obj val = liftIO $ setObjectPropertyString obj "text" val constructEntryBufferText :: T.Text -> IO ([Char], GValue) constructEntryBufferText val = constructObjectPropertyString "text" val data EntryBufferTextPropertyInfo instance AttrInfo EntryBufferTextPropertyInfo where type AttrAllowedOps EntryBufferTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryBufferTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint EntryBufferTextPropertyInfo = EntryBufferK type AttrGetType EntryBufferTextPropertyInfo = T.Text type AttrLabel EntryBufferTextPropertyInfo = "EntryBuffer::text" attrGet _ = getEntryBufferText attrSet _ = setEntryBufferText attrConstruct _ = constructEntryBufferText type instance AttributeList EntryBuffer = '[ '("length", EntryBufferLengthPropertyInfo), '("max-length", EntryBufferMaxLengthPropertyInfo), '("text", EntryBufferTextPropertyInfo)] -- VVV Prop "cell-area" -- Type: TInterface "Gtk" "CellArea" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getEntryCompletionCellArea :: (MonadIO m, EntryCompletionK o) => o -> m CellArea getEntryCompletionCellArea obj = liftIO $ getObjectPropertyObject obj "cell-area" CellArea constructEntryCompletionCellArea :: (CellAreaK a) => a -> IO ([Char], GValue) constructEntryCompletionCellArea val = constructObjectPropertyObject "cell-area" val data EntryCompletionCellAreaPropertyInfo instance AttrInfo EntryCompletionCellAreaPropertyInfo where type AttrAllowedOps EntryCompletionCellAreaPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCompletionCellAreaPropertyInfo = CellAreaK type AttrBaseTypeConstraint EntryCompletionCellAreaPropertyInfo = EntryCompletionK type AttrGetType EntryCompletionCellAreaPropertyInfo = CellArea type AttrLabel EntryCompletionCellAreaPropertyInfo = "EntryCompletion::cell-area" attrGet _ = getEntryCompletionCellArea attrSet _ = undefined attrConstruct _ = constructEntryCompletionCellArea -- VVV Prop "inline-completion" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryCompletionInlineCompletion :: (MonadIO m, EntryCompletionK o) => o -> m Bool getEntryCompletionInlineCompletion obj = liftIO $ getObjectPropertyBool obj "inline-completion" setEntryCompletionInlineCompletion :: (MonadIO m, EntryCompletionK o) => o -> Bool -> m () setEntryCompletionInlineCompletion obj val = liftIO $ setObjectPropertyBool obj "inline-completion" val constructEntryCompletionInlineCompletion :: Bool -> IO ([Char], GValue) constructEntryCompletionInlineCompletion val = constructObjectPropertyBool "inline-completion" val data EntryCompletionInlineCompletionPropertyInfo instance AttrInfo EntryCompletionInlineCompletionPropertyInfo where type AttrAllowedOps EntryCompletionInlineCompletionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCompletionInlineCompletionPropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryCompletionInlineCompletionPropertyInfo = EntryCompletionK type AttrGetType EntryCompletionInlineCompletionPropertyInfo = Bool type AttrLabel EntryCompletionInlineCompletionPropertyInfo = "EntryCompletion::inline-completion" attrGet _ = getEntryCompletionInlineCompletion attrSet _ = setEntryCompletionInlineCompletion attrConstruct _ = constructEntryCompletionInlineCompletion -- VVV Prop "inline-selection" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryCompletionInlineSelection :: (MonadIO m, EntryCompletionK o) => o -> m Bool getEntryCompletionInlineSelection obj = liftIO $ getObjectPropertyBool obj "inline-selection" setEntryCompletionInlineSelection :: (MonadIO m, EntryCompletionK o) => o -> Bool -> m () setEntryCompletionInlineSelection obj val = liftIO $ setObjectPropertyBool obj "inline-selection" val constructEntryCompletionInlineSelection :: Bool -> IO ([Char], GValue) constructEntryCompletionInlineSelection val = constructObjectPropertyBool "inline-selection" val data EntryCompletionInlineSelectionPropertyInfo instance AttrInfo EntryCompletionInlineSelectionPropertyInfo where type AttrAllowedOps EntryCompletionInlineSelectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCompletionInlineSelectionPropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryCompletionInlineSelectionPropertyInfo = EntryCompletionK type AttrGetType EntryCompletionInlineSelectionPropertyInfo = Bool type AttrLabel EntryCompletionInlineSelectionPropertyInfo = "EntryCompletion::inline-selection" attrGet _ = getEntryCompletionInlineSelection attrSet _ = setEntryCompletionInlineSelection attrConstruct _ = constructEntryCompletionInlineSelection -- VVV Prop "minimum-key-length" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getEntryCompletionMinimumKeyLength :: (MonadIO m, EntryCompletionK o) => o -> m Int32 getEntryCompletionMinimumKeyLength obj = liftIO $ getObjectPropertyCInt obj "minimum-key-length" setEntryCompletionMinimumKeyLength :: (MonadIO m, EntryCompletionK o) => o -> Int32 -> m () setEntryCompletionMinimumKeyLength obj val = liftIO $ setObjectPropertyCInt obj "minimum-key-length" val constructEntryCompletionMinimumKeyLength :: Int32 -> IO ([Char], GValue) constructEntryCompletionMinimumKeyLength val = constructObjectPropertyCInt "minimum-key-length" val data EntryCompletionMinimumKeyLengthPropertyInfo instance AttrInfo EntryCompletionMinimumKeyLengthPropertyInfo where type AttrAllowedOps EntryCompletionMinimumKeyLengthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCompletionMinimumKeyLengthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint EntryCompletionMinimumKeyLengthPropertyInfo = EntryCompletionK type AttrGetType EntryCompletionMinimumKeyLengthPropertyInfo = Int32 type AttrLabel EntryCompletionMinimumKeyLengthPropertyInfo = "EntryCompletion::minimum-key-length" attrGet _ = getEntryCompletionMinimumKeyLength attrSet _ = setEntryCompletionMinimumKeyLength attrConstruct _ = constructEntryCompletionMinimumKeyLength -- VVV Prop "model" -- Type: TInterface "Gtk" "TreeModel" -- Flags: [PropertyReadable,PropertyWritable] getEntryCompletionModel :: (MonadIO m, EntryCompletionK o) => o -> m TreeModel getEntryCompletionModel obj = liftIO $ getObjectPropertyObject obj "model" TreeModel setEntryCompletionModel :: (MonadIO m, EntryCompletionK o, TreeModelK a) => o -> a -> m () setEntryCompletionModel obj val = liftIO $ setObjectPropertyObject obj "model" val constructEntryCompletionModel :: (TreeModelK a) => a -> IO ([Char], GValue) constructEntryCompletionModel val = constructObjectPropertyObject "model" val data EntryCompletionModelPropertyInfo instance AttrInfo EntryCompletionModelPropertyInfo where type AttrAllowedOps EntryCompletionModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCompletionModelPropertyInfo = TreeModelK type AttrBaseTypeConstraint EntryCompletionModelPropertyInfo = EntryCompletionK type AttrGetType EntryCompletionModelPropertyInfo = TreeModel type AttrLabel EntryCompletionModelPropertyInfo = "EntryCompletion::model" attrGet _ = getEntryCompletionModel attrSet _ = setEntryCompletionModel attrConstruct _ = constructEntryCompletionModel -- VVV Prop "popup-completion" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryCompletionPopupCompletion :: (MonadIO m, EntryCompletionK o) => o -> m Bool getEntryCompletionPopupCompletion obj = liftIO $ getObjectPropertyBool obj "popup-completion" setEntryCompletionPopupCompletion :: (MonadIO m, EntryCompletionK o) => o -> Bool -> m () setEntryCompletionPopupCompletion obj val = liftIO $ setObjectPropertyBool obj "popup-completion" val constructEntryCompletionPopupCompletion :: Bool -> IO ([Char], GValue) constructEntryCompletionPopupCompletion val = constructObjectPropertyBool "popup-completion" val data EntryCompletionPopupCompletionPropertyInfo instance AttrInfo EntryCompletionPopupCompletionPropertyInfo where type AttrAllowedOps EntryCompletionPopupCompletionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCompletionPopupCompletionPropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryCompletionPopupCompletionPropertyInfo = EntryCompletionK type AttrGetType EntryCompletionPopupCompletionPropertyInfo = Bool type AttrLabel EntryCompletionPopupCompletionPropertyInfo = "EntryCompletion::popup-completion" attrGet _ = getEntryCompletionPopupCompletion attrSet _ = setEntryCompletionPopupCompletion attrConstruct _ = constructEntryCompletionPopupCompletion -- VVV Prop "popup-set-width" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryCompletionPopupSetWidth :: (MonadIO m, EntryCompletionK o) => o -> m Bool getEntryCompletionPopupSetWidth obj = liftIO $ getObjectPropertyBool obj "popup-set-width" setEntryCompletionPopupSetWidth :: (MonadIO m, EntryCompletionK o) => o -> Bool -> m () setEntryCompletionPopupSetWidth obj val = liftIO $ setObjectPropertyBool obj "popup-set-width" val constructEntryCompletionPopupSetWidth :: Bool -> IO ([Char], GValue) constructEntryCompletionPopupSetWidth val = constructObjectPropertyBool "popup-set-width" val data EntryCompletionPopupSetWidthPropertyInfo instance AttrInfo EntryCompletionPopupSetWidthPropertyInfo where type AttrAllowedOps EntryCompletionPopupSetWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCompletionPopupSetWidthPropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryCompletionPopupSetWidthPropertyInfo = EntryCompletionK type AttrGetType EntryCompletionPopupSetWidthPropertyInfo = Bool type AttrLabel EntryCompletionPopupSetWidthPropertyInfo = "EntryCompletion::popup-set-width" attrGet _ = getEntryCompletionPopupSetWidth attrSet _ = setEntryCompletionPopupSetWidth attrConstruct _ = constructEntryCompletionPopupSetWidth -- VVV Prop "popup-single-match" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEntryCompletionPopupSingleMatch :: (MonadIO m, EntryCompletionK o) => o -> m Bool getEntryCompletionPopupSingleMatch obj = liftIO $ getObjectPropertyBool obj "popup-single-match" setEntryCompletionPopupSingleMatch :: (MonadIO m, EntryCompletionK o) => o -> Bool -> m () setEntryCompletionPopupSingleMatch obj val = liftIO $ setObjectPropertyBool obj "popup-single-match" val constructEntryCompletionPopupSingleMatch :: Bool -> IO ([Char], GValue) constructEntryCompletionPopupSingleMatch val = constructObjectPropertyBool "popup-single-match" val data EntryCompletionPopupSingleMatchPropertyInfo instance AttrInfo EntryCompletionPopupSingleMatchPropertyInfo where type AttrAllowedOps EntryCompletionPopupSingleMatchPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCompletionPopupSingleMatchPropertyInfo = (~) Bool type AttrBaseTypeConstraint EntryCompletionPopupSingleMatchPropertyInfo = EntryCompletionK type AttrGetType EntryCompletionPopupSingleMatchPropertyInfo = Bool type AttrLabel EntryCompletionPopupSingleMatchPropertyInfo = "EntryCompletion::popup-single-match" attrGet _ = getEntryCompletionPopupSingleMatch attrSet _ = setEntryCompletionPopupSingleMatch attrConstruct _ = constructEntryCompletionPopupSingleMatch -- VVV Prop "text-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getEntryCompletionTextColumn :: (MonadIO m, EntryCompletionK o) => o -> m Int32 getEntryCompletionTextColumn obj = liftIO $ getObjectPropertyCInt obj "text-column" setEntryCompletionTextColumn :: (MonadIO m, EntryCompletionK o) => o -> Int32 -> m () setEntryCompletionTextColumn obj val = liftIO $ setObjectPropertyCInt obj "text-column" val constructEntryCompletionTextColumn :: Int32 -> IO ([Char], GValue) constructEntryCompletionTextColumn val = constructObjectPropertyCInt "text-column" val data EntryCompletionTextColumnPropertyInfo instance AttrInfo EntryCompletionTextColumnPropertyInfo where type AttrAllowedOps EntryCompletionTextColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EntryCompletionTextColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint EntryCompletionTextColumnPropertyInfo = EntryCompletionK type AttrGetType EntryCompletionTextColumnPropertyInfo = Int32 type AttrLabel EntryCompletionTextColumnPropertyInfo = "EntryCompletion::text-column" attrGet _ = getEntryCompletionTextColumn attrSet _ = setEntryCompletionTextColumn attrConstruct _ = constructEntryCompletionTextColumn type instance AttributeList EntryCompletion = '[ '("cell-area", EntryCompletionCellAreaPropertyInfo), '("inline-completion", EntryCompletionInlineCompletionPropertyInfo), '("inline-selection", EntryCompletionInlineSelectionPropertyInfo), '("minimum-key-length", EntryCompletionMinimumKeyLengthPropertyInfo), '("model", EntryCompletionModelPropertyInfo), '("popup-completion", EntryCompletionPopupCompletionPropertyInfo), '("popup-set-width", EntryCompletionPopupSetWidthPropertyInfo), '("popup-single-match", EntryCompletionPopupSingleMatchPropertyInfo), '("text-column", EntryCompletionTextColumnPropertyInfo)] type instance AttributeList EntryIconAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo)] -- VVV Prop "above-child" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEventBoxAboveChild :: (MonadIO m, EventBoxK o) => o -> m Bool getEventBoxAboveChild obj = liftIO $ getObjectPropertyBool obj "above-child" setEventBoxAboveChild :: (MonadIO m, EventBoxK o) => o -> Bool -> m () setEventBoxAboveChild obj val = liftIO $ setObjectPropertyBool obj "above-child" val constructEventBoxAboveChild :: Bool -> IO ([Char], GValue) constructEventBoxAboveChild val = constructObjectPropertyBool "above-child" val data EventBoxAboveChildPropertyInfo instance AttrInfo EventBoxAboveChildPropertyInfo where type AttrAllowedOps EventBoxAboveChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EventBoxAboveChildPropertyInfo = (~) Bool type AttrBaseTypeConstraint EventBoxAboveChildPropertyInfo = EventBoxK type AttrGetType EventBoxAboveChildPropertyInfo = Bool type AttrLabel EventBoxAboveChildPropertyInfo = "EventBox::above-child" attrGet _ = getEventBoxAboveChild attrSet _ = setEventBoxAboveChild attrConstruct _ = constructEventBoxAboveChild -- VVV Prop "visible-window" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getEventBoxVisibleWindow :: (MonadIO m, EventBoxK o) => o -> m Bool getEventBoxVisibleWindow obj = liftIO $ getObjectPropertyBool obj "visible-window" setEventBoxVisibleWindow :: (MonadIO m, EventBoxK o) => o -> Bool -> m () setEventBoxVisibleWindow obj val = liftIO $ setObjectPropertyBool obj "visible-window" val constructEventBoxVisibleWindow :: Bool -> IO ([Char], GValue) constructEventBoxVisibleWindow val = constructObjectPropertyBool "visible-window" val data EventBoxVisibleWindowPropertyInfo instance AttrInfo EventBoxVisibleWindowPropertyInfo where type AttrAllowedOps EventBoxVisibleWindowPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EventBoxVisibleWindowPropertyInfo = (~) Bool type AttrBaseTypeConstraint EventBoxVisibleWindowPropertyInfo = EventBoxK type AttrGetType EventBoxVisibleWindowPropertyInfo = Bool type AttrLabel EventBoxVisibleWindowPropertyInfo = "EventBox::visible-window" attrGet _ = getEventBoxVisibleWindow attrSet _ = setEventBoxVisibleWindow attrConstruct _ = constructEventBoxVisibleWindow type instance AttributeList EventBox = '[ '("above-child", EventBoxAboveChildPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("visible-window", EventBoxVisibleWindowPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "propagation-phase" -- Type: TInterface "Gtk" "PropagationPhase" -- Flags: [PropertyReadable,PropertyWritable] getEventControllerPropagationPhase :: (MonadIO m, EventControllerK o) => o -> m PropagationPhase getEventControllerPropagationPhase obj = liftIO $ getObjectPropertyEnum obj "propagation-phase" setEventControllerPropagationPhase :: (MonadIO m, EventControllerK o) => o -> PropagationPhase -> m () setEventControllerPropagationPhase obj val = liftIO $ setObjectPropertyEnum obj "propagation-phase" val constructEventControllerPropagationPhase :: PropagationPhase -> IO ([Char], GValue) constructEventControllerPropagationPhase val = constructObjectPropertyEnum "propagation-phase" val data EventControllerPropagationPhasePropertyInfo instance AttrInfo EventControllerPropagationPhasePropertyInfo where type AttrAllowedOps EventControllerPropagationPhasePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EventControllerPropagationPhasePropertyInfo = (~) PropagationPhase type AttrBaseTypeConstraint EventControllerPropagationPhasePropertyInfo = EventControllerK type AttrGetType EventControllerPropagationPhasePropertyInfo = PropagationPhase type AttrLabel EventControllerPropagationPhasePropertyInfo = "EventController::propagation-phase" attrGet _ = getEventControllerPropagationPhase attrSet _ = setEventControllerPropagationPhase attrConstruct _ = constructEventControllerPropagationPhase -- VVV Prop "widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getEventControllerWidget :: (MonadIO m, EventControllerK o) => o -> m Widget getEventControllerWidget obj = liftIO $ getObjectPropertyObject obj "widget" Widget constructEventControllerWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructEventControllerWidget val = constructObjectPropertyObject "widget" val data EventControllerWidgetPropertyInfo instance AttrInfo EventControllerWidgetPropertyInfo where type AttrAllowedOps EventControllerWidgetPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EventControllerWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint EventControllerWidgetPropertyInfo = EventControllerK type AttrGetType EventControllerWidgetPropertyInfo = Widget type AttrLabel EventControllerWidgetPropertyInfo = "EventController::widget" attrGet _ = getEventControllerWidget attrSet _ = undefined attrConstruct _ = constructEventControllerWidget type instance AttributeList EventController = '[ '("propagation-phase", EventControllerPropagationPhasePropertyInfo), '("widget", EventControllerWidgetPropertyInfo)] -- VVV Prop "expanded" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getExpanderExpanded :: (MonadIO m, ExpanderK o) => o -> m Bool getExpanderExpanded obj = liftIO $ getObjectPropertyBool obj "expanded" setExpanderExpanded :: (MonadIO m, ExpanderK o) => o -> Bool -> m () setExpanderExpanded obj val = liftIO $ setObjectPropertyBool obj "expanded" val constructExpanderExpanded :: Bool -> IO ([Char], GValue) constructExpanderExpanded val = constructObjectPropertyBool "expanded" val data ExpanderExpandedPropertyInfo instance AttrInfo ExpanderExpandedPropertyInfo where type AttrAllowedOps ExpanderExpandedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ExpanderExpandedPropertyInfo = (~) Bool type AttrBaseTypeConstraint ExpanderExpandedPropertyInfo = ExpanderK type AttrGetType ExpanderExpandedPropertyInfo = Bool type AttrLabel ExpanderExpandedPropertyInfo = "Expander::expanded" attrGet _ = getExpanderExpanded attrSet _ = setExpanderExpanded attrConstruct _ = constructExpanderExpanded -- VVV Prop "label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getExpanderLabel :: (MonadIO m, ExpanderK o) => o -> m T.Text getExpanderLabel obj = liftIO $ getObjectPropertyString obj "label" setExpanderLabel :: (MonadIO m, ExpanderK o) => o -> T.Text -> m () setExpanderLabel obj val = liftIO $ setObjectPropertyString obj "label" val constructExpanderLabel :: T.Text -> IO ([Char], GValue) constructExpanderLabel val = constructObjectPropertyString "label" val data ExpanderLabelPropertyInfo instance AttrInfo ExpanderLabelPropertyInfo where type AttrAllowedOps ExpanderLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ExpanderLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ExpanderLabelPropertyInfo = ExpanderK type AttrGetType ExpanderLabelPropertyInfo = T.Text type AttrLabel ExpanderLabelPropertyInfo = "Expander::label" attrGet _ = getExpanderLabel attrSet _ = setExpanderLabel attrConstruct _ = constructExpanderLabel -- VVV Prop "label-fill" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getExpanderLabelFill :: (MonadIO m, ExpanderK o) => o -> m Bool getExpanderLabelFill obj = liftIO $ getObjectPropertyBool obj "label-fill" setExpanderLabelFill :: (MonadIO m, ExpanderK o) => o -> Bool -> m () setExpanderLabelFill obj val = liftIO $ setObjectPropertyBool obj "label-fill" val constructExpanderLabelFill :: Bool -> IO ([Char], GValue) constructExpanderLabelFill val = constructObjectPropertyBool "label-fill" val data ExpanderLabelFillPropertyInfo instance AttrInfo ExpanderLabelFillPropertyInfo where type AttrAllowedOps ExpanderLabelFillPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ExpanderLabelFillPropertyInfo = (~) Bool type AttrBaseTypeConstraint ExpanderLabelFillPropertyInfo = ExpanderK type AttrGetType ExpanderLabelFillPropertyInfo = Bool type AttrLabel ExpanderLabelFillPropertyInfo = "Expander::label-fill" attrGet _ = getExpanderLabelFill attrSet _ = setExpanderLabelFill attrConstruct _ = constructExpanderLabelFill -- VVV Prop "label-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getExpanderLabelWidget :: (MonadIO m, ExpanderK o) => o -> m Widget getExpanderLabelWidget obj = liftIO $ getObjectPropertyObject obj "label-widget" Widget setExpanderLabelWidget :: (MonadIO m, ExpanderK o, WidgetK a) => o -> a -> m () setExpanderLabelWidget obj val = liftIO $ setObjectPropertyObject obj "label-widget" val constructExpanderLabelWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructExpanderLabelWidget val = constructObjectPropertyObject "label-widget" val data ExpanderLabelWidgetPropertyInfo instance AttrInfo ExpanderLabelWidgetPropertyInfo where type AttrAllowedOps ExpanderLabelWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ExpanderLabelWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint ExpanderLabelWidgetPropertyInfo = ExpanderK type AttrGetType ExpanderLabelWidgetPropertyInfo = Widget type AttrLabel ExpanderLabelWidgetPropertyInfo = "Expander::label-widget" attrGet _ = getExpanderLabelWidget attrSet _ = setExpanderLabelWidget attrConstruct _ = constructExpanderLabelWidget -- VVV Prop "resize-toplevel" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getExpanderResizeToplevel :: (MonadIO m, ExpanderK o) => o -> m Bool getExpanderResizeToplevel obj = liftIO $ getObjectPropertyBool obj "resize-toplevel" setExpanderResizeToplevel :: (MonadIO m, ExpanderK o) => o -> Bool -> m () setExpanderResizeToplevel obj val = liftIO $ setObjectPropertyBool obj "resize-toplevel" val constructExpanderResizeToplevel :: Bool -> IO ([Char], GValue) constructExpanderResizeToplevel val = constructObjectPropertyBool "resize-toplevel" val data ExpanderResizeToplevelPropertyInfo instance AttrInfo ExpanderResizeToplevelPropertyInfo where type AttrAllowedOps ExpanderResizeToplevelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ExpanderResizeToplevelPropertyInfo = (~) Bool type AttrBaseTypeConstraint ExpanderResizeToplevelPropertyInfo = ExpanderK type AttrGetType ExpanderResizeToplevelPropertyInfo = Bool type AttrLabel ExpanderResizeToplevelPropertyInfo = "Expander::resize-toplevel" attrGet _ = getExpanderResizeToplevel attrSet _ = setExpanderResizeToplevel attrConstruct _ = constructExpanderResizeToplevel -- VVV Prop "spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getExpanderSpacing :: (MonadIO m, ExpanderK o) => o -> m Int32 getExpanderSpacing obj = liftIO $ getObjectPropertyCInt obj "spacing" setExpanderSpacing :: (MonadIO m, ExpanderK o) => o -> Int32 -> m () setExpanderSpacing obj val = liftIO $ setObjectPropertyCInt obj "spacing" val constructExpanderSpacing :: Int32 -> IO ([Char], GValue) constructExpanderSpacing val = constructObjectPropertyCInt "spacing" val data ExpanderSpacingPropertyInfo instance AttrInfo ExpanderSpacingPropertyInfo where type AttrAllowedOps ExpanderSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ExpanderSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ExpanderSpacingPropertyInfo = ExpanderK type AttrGetType ExpanderSpacingPropertyInfo = Int32 type AttrLabel ExpanderSpacingPropertyInfo = "Expander::spacing" attrGet _ = getExpanderSpacing attrSet _ = setExpanderSpacing attrConstruct _ = constructExpanderSpacing -- VVV Prop "use-markup" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getExpanderUseMarkup :: (MonadIO m, ExpanderK o) => o -> m Bool getExpanderUseMarkup obj = liftIO $ getObjectPropertyBool obj "use-markup" setExpanderUseMarkup :: (MonadIO m, ExpanderK o) => o -> Bool -> m () setExpanderUseMarkup obj val = liftIO $ setObjectPropertyBool obj "use-markup" val constructExpanderUseMarkup :: Bool -> IO ([Char], GValue) constructExpanderUseMarkup val = constructObjectPropertyBool "use-markup" val data ExpanderUseMarkupPropertyInfo instance AttrInfo ExpanderUseMarkupPropertyInfo where type AttrAllowedOps ExpanderUseMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ExpanderUseMarkupPropertyInfo = (~) Bool type AttrBaseTypeConstraint ExpanderUseMarkupPropertyInfo = ExpanderK type AttrGetType ExpanderUseMarkupPropertyInfo = Bool type AttrLabel ExpanderUseMarkupPropertyInfo = "Expander::use-markup" attrGet _ = getExpanderUseMarkup attrSet _ = setExpanderUseMarkup attrConstruct _ = constructExpanderUseMarkup -- VVV Prop "use-underline" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getExpanderUseUnderline :: (MonadIO m, ExpanderK o) => o -> m Bool getExpanderUseUnderline obj = liftIO $ getObjectPropertyBool obj "use-underline" setExpanderUseUnderline :: (MonadIO m, ExpanderK o) => o -> Bool -> m () setExpanderUseUnderline obj val = liftIO $ setObjectPropertyBool obj "use-underline" val constructExpanderUseUnderline :: Bool -> IO ([Char], GValue) constructExpanderUseUnderline val = constructObjectPropertyBool "use-underline" val data ExpanderUseUnderlinePropertyInfo instance AttrInfo ExpanderUseUnderlinePropertyInfo where type AttrAllowedOps ExpanderUseUnderlinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ExpanderUseUnderlinePropertyInfo = (~) Bool type AttrBaseTypeConstraint ExpanderUseUnderlinePropertyInfo = ExpanderK type AttrGetType ExpanderUseUnderlinePropertyInfo = Bool type AttrLabel ExpanderUseUnderlinePropertyInfo = "Expander::use-underline" attrGet _ = getExpanderUseUnderline attrSet _ = setExpanderUseUnderline attrConstruct _ = constructExpanderUseUnderline type instance AttributeList Expander = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("expanded", ExpanderExpandedPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ExpanderLabelPropertyInfo), '("label-fill", ExpanderLabelFillPropertyInfo), '("label-widget", ExpanderLabelWidgetPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("resize-toplevel", ExpanderResizeToplevelPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", ExpanderSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-markup", ExpanderUseMarkupPropertyInfo), '("use-underline", ExpanderUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList ExpanderAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "action" -- Type: TInterface "Gtk" "FileChooserAction" -- Flags: [PropertyReadable,PropertyWritable] getFileChooserAction :: (MonadIO m, FileChooserK o) => o -> m FileChooserAction getFileChooserAction obj = liftIO $ getObjectPropertyEnum obj "action" setFileChooserAction :: (MonadIO m, FileChooserK o) => o -> FileChooserAction -> m () setFileChooserAction obj val = liftIO $ setObjectPropertyEnum obj "action" val constructFileChooserAction :: FileChooserAction -> IO ([Char], GValue) constructFileChooserAction val = constructObjectPropertyEnum "action" val data FileChooserActionPropertyInfo instance AttrInfo FileChooserActionPropertyInfo where type AttrAllowedOps FileChooserActionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserActionPropertyInfo = (~) FileChooserAction type AttrBaseTypeConstraint FileChooserActionPropertyInfo = FileChooserK type AttrGetType FileChooserActionPropertyInfo = FileChooserAction type AttrLabel FileChooserActionPropertyInfo = "FileChooser::action" attrGet _ = getFileChooserAction attrSet _ = setFileChooserAction attrConstruct _ = constructFileChooserAction -- VVV Prop "create-folders" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserCreateFolders :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserCreateFolders obj = liftIO $ getObjectPropertyBool obj "create-folders" setFileChooserCreateFolders :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserCreateFolders obj val = liftIO $ setObjectPropertyBool obj "create-folders" val constructFileChooserCreateFolders :: Bool -> IO ([Char], GValue) constructFileChooserCreateFolders val = constructObjectPropertyBool "create-folders" val data FileChooserCreateFoldersPropertyInfo instance AttrInfo FileChooserCreateFoldersPropertyInfo where type AttrAllowedOps FileChooserCreateFoldersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserCreateFoldersPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserCreateFoldersPropertyInfo = FileChooserK type AttrGetType FileChooserCreateFoldersPropertyInfo = Bool type AttrLabel FileChooserCreateFoldersPropertyInfo = "FileChooser::create-folders" attrGet _ = getFileChooserCreateFolders attrSet _ = setFileChooserCreateFolders attrConstruct _ = constructFileChooserCreateFolders -- VVV Prop "do-overwrite-confirmation" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserDoOverwriteConfirmation :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserDoOverwriteConfirmation obj = liftIO $ getObjectPropertyBool obj "do-overwrite-confirmation" setFileChooserDoOverwriteConfirmation :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserDoOverwriteConfirmation obj val = liftIO $ setObjectPropertyBool obj "do-overwrite-confirmation" val constructFileChooserDoOverwriteConfirmation :: Bool -> IO ([Char], GValue) constructFileChooserDoOverwriteConfirmation val = constructObjectPropertyBool "do-overwrite-confirmation" val data FileChooserDoOverwriteConfirmationPropertyInfo instance AttrInfo FileChooserDoOverwriteConfirmationPropertyInfo where type AttrAllowedOps FileChooserDoOverwriteConfirmationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserDoOverwriteConfirmationPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserDoOverwriteConfirmationPropertyInfo = FileChooserK type AttrGetType FileChooserDoOverwriteConfirmationPropertyInfo = Bool type AttrLabel FileChooserDoOverwriteConfirmationPropertyInfo = "FileChooser::do-overwrite-confirmation" attrGet _ = getFileChooserDoOverwriteConfirmation attrSet _ = setFileChooserDoOverwriteConfirmation attrConstruct _ = constructFileChooserDoOverwriteConfirmation -- VVV Prop "extra-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getFileChooserExtraWidget :: (MonadIO m, FileChooserK o) => o -> m Widget getFileChooserExtraWidget obj = liftIO $ getObjectPropertyObject obj "extra-widget" Widget setFileChooserExtraWidget :: (MonadIO m, FileChooserK o, WidgetK a) => o -> a -> m () setFileChooserExtraWidget obj val = liftIO $ setObjectPropertyObject obj "extra-widget" val constructFileChooserExtraWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructFileChooserExtraWidget val = constructObjectPropertyObject "extra-widget" val data FileChooserExtraWidgetPropertyInfo instance AttrInfo FileChooserExtraWidgetPropertyInfo where type AttrAllowedOps FileChooserExtraWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserExtraWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint FileChooserExtraWidgetPropertyInfo = FileChooserK type AttrGetType FileChooserExtraWidgetPropertyInfo = Widget type AttrLabel FileChooserExtraWidgetPropertyInfo = "FileChooser::extra-widget" attrGet _ = getFileChooserExtraWidget attrSet _ = setFileChooserExtraWidget attrConstruct _ = constructFileChooserExtraWidget -- VVV Prop "filter" -- Type: TInterface "Gtk" "FileFilter" -- Flags: [PropertyReadable,PropertyWritable] getFileChooserFilter :: (MonadIO m, FileChooserK o) => o -> m FileFilter getFileChooserFilter obj = liftIO $ getObjectPropertyObject obj "filter" FileFilter setFileChooserFilter :: (MonadIO m, FileChooserK o, FileFilterK a) => o -> a -> m () setFileChooserFilter obj val = liftIO $ setObjectPropertyObject obj "filter" val constructFileChooserFilter :: (FileFilterK a) => a -> IO ([Char], GValue) constructFileChooserFilter val = constructObjectPropertyObject "filter" val data FileChooserFilterPropertyInfo instance AttrInfo FileChooserFilterPropertyInfo where type AttrAllowedOps FileChooserFilterPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserFilterPropertyInfo = FileFilterK type AttrBaseTypeConstraint FileChooserFilterPropertyInfo = FileChooserK type AttrGetType FileChooserFilterPropertyInfo = FileFilter type AttrLabel FileChooserFilterPropertyInfo = "FileChooser::filter" attrGet _ = getFileChooserFilter attrSet _ = setFileChooserFilter attrConstruct _ = constructFileChooserFilter -- VVV Prop "local-only" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserLocalOnly :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserLocalOnly obj = liftIO $ getObjectPropertyBool obj "local-only" setFileChooserLocalOnly :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserLocalOnly obj val = liftIO $ setObjectPropertyBool obj "local-only" val constructFileChooserLocalOnly :: Bool -> IO ([Char], GValue) constructFileChooserLocalOnly val = constructObjectPropertyBool "local-only" val data FileChooserLocalOnlyPropertyInfo instance AttrInfo FileChooserLocalOnlyPropertyInfo where type AttrAllowedOps FileChooserLocalOnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserLocalOnlyPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserLocalOnlyPropertyInfo = FileChooserK type AttrGetType FileChooserLocalOnlyPropertyInfo = Bool type AttrLabel FileChooserLocalOnlyPropertyInfo = "FileChooser::local-only" attrGet _ = getFileChooserLocalOnly attrSet _ = setFileChooserLocalOnly attrConstruct _ = constructFileChooserLocalOnly -- VVV Prop "preview-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getFileChooserPreviewWidget :: (MonadIO m, FileChooserK o) => o -> m Widget getFileChooserPreviewWidget obj = liftIO $ getObjectPropertyObject obj "preview-widget" Widget setFileChooserPreviewWidget :: (MonadIO m, FileChooserK o, WidgetK a) => o -> a -> m () setFileChooserPreviewWidget obj val = liftIO $ setObjectPropertyObject obj "preview-widget" val constructFileChooserPreviewWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructFileChooserPreviewWidget val = constructObjectPropertyObject "preview-widget" val data FileChooserPreviewWidgetPropertyInfo instance AttrInfo FileChooserPreviewWidgetPropertyInfo where type AttrAllowedOps FileChooserPreviewWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserPreviewWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint FileChooserPreviewWidgetPropertyInfo = FileChooserK type AttrGetType FileChooserPreviewWidgetPropertyInfo = Widget type AttrLabel FileChooserPreviewWidgetPropertyInfo = "FileChooser::preview-widget" attrGet _ = getFileChooserPreviewWidget attrSet _ = setFileChooserPreviewWidget attrConstruct _ = constructFileChooserPreviewWidget -- VVV Prop "preview-widget-active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserPreviewWidgetActive :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserPreviewWidgetActive obj = liftIO $ getObjectPropertyBool obj "preview-widget-active" setFileChooserPreviewWidgetActive :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserPreviewWidgetActive obj val = liftIO $ setObjectPropertyBool obj "preview-widget-active" val constructFileChooserPreviewWidgetActive :: Bool -> IO ([Char], GValue) constructFileChooserPreviewWidgetActive val = constructObjectPropertyBool "preview-widget-active" val data FileChooserPreviewWidgetActivePropertyInfo instance AttrInfo FileChooserPreviewWidgetActivePropertyInfo where type AttrAllowedOps FileChooserPreviewWidgetActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserPreviewWidgetActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserPreviewWidgetActivePropertyInfo = FileChooserK type AttrGetType FileChooserPreviewWidgetActivePropertyInfo = Bool type AttrLabel FileChooserPreviewWidgetActivePropertyInfo = "FileChooser::preview-widget-active" attrGet _ = getFileChooserPreviewWidgetActive attrSet _ = setFileChooserPreviewWidgetActive attrConstruct _ = constructFileChooserPreviewWidgetActive -- VVV Prop "select-multiple" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserSelectMultiple :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserSelectMultiple obj = liftIO $ getObjectPropertyBool obj "select-multiple" setFileChooserSelectMultiple :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserSelectMultiple obj val = liftIO $ setObjectPropertyBool obj "select-multiple" val constructFileChooserSelectMultiple :: Bool -> IO ([Char], GValue) constructFileChooserSelectMultiple val = constructObjectPropertyBool "select-multiple" val data FileChooserSelectMultiplePropertyInfo instance AttrInfo FileChooserSelectMultiplePropertyInfo where type AttrAllowedOps FileChooserSelectMultiplePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserSelectMultiplePropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserSelectMultiplePropertyInfo = FileChooserK type AttrGetType FileChooserSelectMultiplePropertyInfo = Bool type AttrLabel FileChooserSelectMultiplePropertyInfo = "FileChooser::select-multiple" attrGet _ = getFileChooserSelectMultiple attrSet _ = setFileChooserSelectMultiple attrConstruct _ = constructFileChooserSelectMultiple -- VVV Prop "show-hidden" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserShowHidden :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserShowHidden obj = liftIO $ getObjectPropertyBool obj "show-hidden" setFileChooserShowHidden :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserShowHidden obj val = liftIO $ setObjectPropertyBool obj "show-hidden" val constructFileChooserShowHidden :: Bool -> IO ([Char], GValue) constructFileChooserShowHidden val = constructObjectPropertyBool "show-hidden" val data FileChooserShowHiddenPropertyInfo instance AttrInfo FileChooserShowHiddenPropertyInfo where type AttrAllowedOps FileChooserShowHiddenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserShowHiddenPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserShowHiddenPropertyInfo = FileChooserK type AttrGetType FileChooserShowHiddenPropertyInfo = Bool type AttrLabel FileChooserShowHiddenPropertyInfo = "FileChooser::show-hidden" attrGet _ = getFileChooserShowHidden attrSet _ = setFileChooserShowHidden attrConstruct _ = constructFileChooserShowHidden -- VVV Prop "use-preview-label" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserUsePreviewLabel :: (MonadIO m, FileChooserK o) => o -> m Bool getFileChooserUsePreviewLabel obj = liftIO $ getObjectPropertyBool obj "use-preview-label" setFileChooserUsePreviewLabel :: (MonadIO m, FileChooserK o) => o -> Bool -> m () setFileChooserUsePreviewLabel obj val = liftIO $ setObjectPropertyBool obj "use-preview-label" val constructFileChooserUsePreviewLabel :: Bool -> IO ([Char], GValue) constructFileChooserUsePreviewLabel val = constructObjectPropertyBool "use-preview-label" val data FileChooserUsePreviewLabelPropertyInfo instance AttrInfo FileChooserUsePreviewLabelPropertyInfo where type AttrAllowedOps FileChooserUsePreviewLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserUsePreviewLabelPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserUsePreviewLabelPropertyInfo = FileChooserK type AttrGetType FileChooserUsePreviewLabelPropertyInfo = Bool type AttrLabel FileChooserUsePreviewLabelPropertyInfo = "FileChooser::use-preview-label" attrGet _ = getFileChooserUsePreviewLabel attrSet _ = setFileChooserUsePreviewLabel attrConstruct _ = constructFileChooserUsePreviewLabel type instance AttributeList FileChooser = '[ '("action", FileChooserActionPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("create-folders", FileChooserCreateFoldersPropertyInfo), '("do-overwrite-confirmation", FileChooserDoOverwriteConfirmationPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("extra-widget", FileChooserExtraWidgetPropertyInfo), '("filter", FileChooserFilterPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("local-only", FileChooserLocalOnlyPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("preview-widget", FileChooserPreviewWidgetPropertyInfo), '("preview-widget-active", FileChooserPreviewWidgetActivePropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("select-multiple", FileChooserSelectMultiplePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-hidden", FileChooserShowHiddenPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-preview-label", FileChooserUsePreviewLabelPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "dialog" -- Type: TInterface "Gtk" "FileChooser" -- Flags: [PropertyWritable,PropertyConstructOnly] constructFileChooserButtonDialog :: (FileChooserK a) => a -> IO ([Char], GValue) constructFileChooserButtonDialog val = constructObjectPropertyObject "dialog" val data FileChooserButtonDialogPropertyInfo instance AttrInfo FileChooserButtonDialogPropertyInfo where type AttrAllowedOps FileChooserButtonDialogPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint FileChooserButtonDialogPropertyInfo = FileChooserK type AttrBaseTypeConstraint FileChooserButtonDialogPropertyInfo = FileChooserButtonK type AttrGetType FileChooserButtonDialogPropertyInfo = () type AttrLabel FileChooserButtonDialogPropertyInfo = "FileChooserButton::dialog" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructFileChooserButtonDialog -- VVV Prop "focus-on-click" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserButtonFocusOnClick :: (MonadIO m, FileChooserButtonK o) => o -> m Bool getFileChooserButtonFocusOnClick obj = liftIO $ getObjectPropertyBool obj "focus-on-click" setFileChooserButtonFocusOnClick :: (MonadIO m, FileChooserButtonK o) => o -> Bool -> m () setFileChooserButtonFocusOnClick obj val = liftIO $ setObjectPropertyBool obj "focus-on-click" val constructFileChooserButtonFocusOnClick :: Bool -> IO ([Char], GValue) constructFileChooserButtonFocusOnClick val = constructObjectPropertyBool "focus-on-click" val data FileChooserButtonFocusOnClickPropertyInfo instance AttrInfo FileChooserButtonFocusOnClickPropertyInfo where type AttrAllowedOps FileChooserButtonFocusOnClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserButtonFocusOnClickPropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserButtonFocusOnClickPropertyInfo = FileChooserButtonK type AttrGetType FileChooserButtonFocusOnClickPropertyInfo = Bool type AttrLabel FileChooserButtonFocusOnClickPropertyInfo = "FileChooserButton::focus-on-click" attrGet _ = getFileChooserButtonFocusOnClick attrSet _ = setFileChooserButtonFocusOnClick attrConstruct _ = constructFileChooserButtonFocusOnClick -- VVV Prop "title" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getFileChooserButtonTitle :: (MonadIO m, FileChooserButtonK o) => o -> m T.Text getFileChooserButtonTitle obj = liftIO $ getObjectPropertyString obj "title" setFileChooserButtonTitle :: (MonadIO m, FileChooserButtonK o) => o -> T.Text -> m () setFileChooserButtonTitle obj val = liftIO $ setObjectPropertyString obj "title" val constructFileChooserButtonTitle :: T.Text -> IO ([Char], GValue) constructFileChooserButtonTitle val = constructObjectPropertyString "title" val data FileChooserButtonTitlePropertyInfo instance AttrInfo FileChooserButtonTitlePropertyInfo where type AttrAllowedOps FileChooserButtonTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserButtonTitlePropertyInfo = (~) T.Text type AttrBaseTypeConstraint FileChooserButtonTitlePropertyInfo = FileChooserButtonK type AttrGetType FileChooserButtonTitlePropertyInfo = T.Text type AttrLabel FileChooserButtonTitlePropertyInfo = "FileChooserButton::title" attrGet _ = getFileChooserButtonTitle attrSet _ = setFileChooserButtonTitle attrConstruct _ = constructFileChooserButtonTitle -- VVV Prop "width-chars" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getFileChooserButtonWidthChars :: (MonadIO m, FileChooserButtonK o) => o -> m Int32 getFileChooserButtonWidthChars obj = liftIO $ getObjectPropertyCInt obj "width-chars" setFileChooserButtonWidthChars :: (MonadIO m, FileChooserButtonK o) => o -> Int32 -> m () setFileChooserButtonWidthChars obj val = liftIO $ setObjectPropertyCInt obj "width-chars" val constructFileChooserButtonWidthChars :: Int32 -> IO ([Char], GValue) constructFileChooserButtonWidthChars val = constructObjectPropertyCInt "width-chars" val data FileChooserButtonWidthCharsPropertyInfo instance AttrInfo FileChooserButtonWidthCharsPropertyInfo where type AttrAllowedOps FileChooserButtonWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserButtonWidthCharsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint FileChooserButtonWidthCharsPropertyInfo = FileChooserButtonK type AttrGetType FileChooserButtonWidthCharsPropertyInfo = Int32 type AttrLabel FileChooserButtonWidthCharsPropertyInfo = "FileChooserButton::width-chars" attrGet _ = getFileChooserButtonWidthChars attrSet _ = setFileChooserButtonWidthChars attrConstruct _ = constructFileChooserButtonWidthChars type instance AttributeList FileChooserButton = '[ '("action", FileChooserActionPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("create-folders", FileChooserCreateFoldersPropertyInfo), '("dialog", FileChooserButtonDialogPropertyInfo), '("do-overwrite-confirmation", FileChooserDoOverwriteConfirmationPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("extra-widget", FileChooserExtraWidgetPropertyInfo), '("filter", FileChooserFilterPropertyInfo), '("focus-on-click", FileChooserButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("local-only", FileChooserLocalOnlyPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("preview-widget", FileChooserPreviewWidgetPropertyInfo), '("preview-widget-active", FileChooserPreviewWidgetActivePropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("select-multiple", FileChooserSelectMultiplePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-hidden", FileChooserShowHiddenPropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", FileChooserButtonTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-preview-label", FileChooserUsePreviewLabelPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-chars", FileChooserButtonWidthCharsPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList FileChooserDialog = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("action", FileChooserActionPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("create-folders", FileChooserCreateFoldersPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("do-overwrite-confirmation", FileChooserDoOverwriteConfirmationPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("extra-widget", FileChooserExtraWidgetPropertyInfo), '("filter", FileChooserFilterPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("local-only", FileChooserLocalOnlyPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("preview-widget", FileChooserPreviewWidgetPropertyInfo), '("preview-widget-active", FileChooserPreviewWidgetActivePropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("select-multiple", FileChooserSelectMultiplePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-hidden", FileChooserShowHiddenPropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-header-bar", DialogUseHeaderBarPropertyInfo), '("use-preview-label", FileChooserUsePreviewLabelPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] -- VVV Prop "search-mode" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFileChooserWidgetSearchMode :: (MonadIO m, FileChooserWidgetK o) => o -> m Bool getFileChooserWidgetSearchMode obj = liftIO $ getObjectPropertyBool obj "search-mode" setFileChooserWidgetSearchMode :: (MonadIO m, FileChooserWidgetK o) => o -> Bool -> m () setFileChooserWidgetSearchMode obj val = liftIO $ setObjectPropertyBool obj "search-mode" val constructFileChooserWidgetSearchMode :: Bool -> IO ([Char], GValue) constructFileChooserWidgetSearchMode val = constructObjectPropertyBool "search-mode" val data FileChooserWidgetSearchModePropertyInfo instance AttrInfo FileChooserWidgetSearchModePropertyInfo where type AttrAllowedOps FileChooserWidgetSearchModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileChooserWidgetSearchModePropertyInfo = (~) Bool type AttrBaseTypeConstraint FileChooserWidgetSearchModePropertyInfo = FileChooserWidgetK type AttrGetType FileChooserWidgetSearchModePropertyInfo = Bool type AttrLabel FileChooserWidgetSearchModePropertyInfo = "FileChooserWidget::search-mode" attrGet _ = getFileChooserWidgetSearchMode attrSet _ = setFileChooserWidgetSearchMode attrConstruct _ = constructFileChooserWidgetSearchMode -- VVV Prop "subtitle" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable] getFileChooserWidgetSubtitle :: (MonadIO m, FileChooserWidgetK o) => o -> m T.Text getFileChooserWidgetSubtitle obj = liftIO $ getObjectPropertyString obj "subtitle" data FileChooserWidgetSubtitlePropertyInfo instance AttrInfo FileChooserWidgetSubtitlePropertyInfo where type AttrAllowedOps FileChooserWidgetSubtitlePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint FileChooserWidgetSubtitlePropertyInfo = (~) () type AttrBaseTypeConstraint FileChooserWidgetSubtitlePropertyInfo = FileChooserWidgetK type AttrGetType FileChooserWidgetSubtitlePropertyInfo = T.Text type AttrLabel FileChooserWidgetSubtitlePropertyInfo = "FileChooserWidget::subtitle" attrGet _ = getFileChooserWidgetSubtitle attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList FileChooserWidget = '[ '("action", FileChooserActionPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("create-folders", FileChooserCreateFoldersPropertyInfo), '("do-overwrite-confirmation", FileChooserDoOverwriteConfirmationPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("extra-widget", FileChooserExtraWidgetPropertyInfo), '("filter", FileChooserFilterPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("local-only", FileChooserLocalOnlyPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("preview-widget", FileChooserPreviewWidgetPropertyInfo), '("preview-widget-active", FileChooserPreviewWidgetActivePropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("search-mode", FileChooserWidgetSearchModePropertyInfo), '("select-multiple", FileChooserSelectMultiplePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-hidden", FileChooserShowHiddenPropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("subtitle", FileChooserWidgetSubtitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-preview-label", FileChooserUsePreviewLabelPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList FileFilter = '[ ] type instance AttributeList Fixed = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "activate-on-single-click" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFlowBoxActivateOnSingleClick :: (MonadIO m, FlowBoxK o) => o -> m Bool getFlowBoxActivateOnSingleClick obj = liftIO $ getObjectPropertyBool obj "activate-on-single-click" setFlowBoxActivateOnSingleClick :: (MonadIO m, FlowBoxK o) => o -> Bool -> m () setFlowBoxActivateOnSingleClick obj val = liftIO $ setObjectPropertyBool obj "activate-on-single-click" val constructFlowBoxActivateOnSingleClick :: Bool -> IO ([Char], GValue) constructFlowBoxActivateOnSingleClick val = constructObjectPropertyBool "activate-on-single-click" val data FlowBoxActivateOnSingleClickPropertyInfo instance AttrInfo FlowBoxActivateOnSingleClickPropertyInfo where type AttrAllowedOps FlowBoxActivateOnSingleClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FlowBoxActivateOnSingleClickPropertyInfo = (~) Bool type AttrBaseTypeConstraint FlowBoxActivateOnSingleClickPropertyInfo = FlowBoxK type AttrGetType FlowBoxActivateOnSingleClickPropertyInfo = Bool type AttrLabel FlowBoxActivateOnSingleClickPropertyInfo = "FlowBox::activate-on-single-click" attrGet _ = getFlowBoxActivateOnSingleClick attrSet _ = setFlowBoxActivateOnSingleClick attrConstruct _ = constructFlowBoxActivateOnSingleClick -- VVV Prop "column-spacing" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getFlowBoxColumnSpacing :: (MonadIO m, FlowBoxK o) => o -> m Word32 getFlowBoxColumnSpacing obj = liftIO $ getObjectPropertyCUInt obj "column-spacing" setFlowBoxColumnSpacing :: (MonadIO m, FlowBoxK o) => o -> Word32 -> m () setFlowBoxColumnSpacing obj val = liftIO $ setObjectPropertyCUInt obj "column-spacing" val constructFlowBoxColumnSpacing :: Word32 -> IO ([Char], GValue) constructFlowBoxColumnSpacing val = constructObjectPropertyCUInt "column-spacing" val data FlowBoxColumnSpacingPropertyInfo instance AttrInfo FlowBoxColumnSpacingPropertyInfo where type AttrAllowedOps FlowBoxColumnSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FlowBoxColumnSpacingPropertyInfo = (~) Word32 type AttrBaseTypeConstraint FlowBoxColumnSpacingPropertyInfo = FlowBoxK type AttrGetType FlowBoxColumnSpacingPropertyInfo = Word32 type AttrLabel FlowBoxColumnSpacingPropertyInfo = "FlowBox::column-spacing" attrGet _ = getFlowBoxColumnSpacing attrSet _ = setFlowBoxColumnSpacing attrConstruct _ = constructFlowBoxColumnSpacing -- VVV Prop "homogeneous" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFlowBoxHomogeneous :: (MonadIO m, FlowBoxK o) => o -> m Bool getFlowBoxHomogeneous obj = liftIO $ getObjectPropertyBool obj "homogeneous" setFlowBoxHomogeneous :: (MonadIO m, FlowBoxK o) => o -> Bool -> m () setFlowBoxHomogeneous obj val = liftIO $ setObjectPropertyBool obj "homogeneous" val constructFlowBoxHomogeneous :: Bool -> IO ([Char], GValue) constructFlowBoxHomogeneous val = constructObjectPropertyBool "homogeneous" val data FlowBoxHomogeneousPropertyInfo instance AttrInfo FlowBoxHomogeneousPropertyInfo where type AttrAllowedOps FlowBoxHomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FlowBoxHomogeneousPropertyInfo = (~) Bool type AttrBaseTypeConstraint FlowBoxHomogeneousPropertyInfo = FlowBoxK type AttrGetType FlowBoxHomogeneousPropertyInfo = Bool type AttrLabel FlowBoxHomogeneousPropertyInfo = "FlowBox::homogeneous" attrGet _ = getFlowBoxHomogeneous attrSet _ = setFlowBoxHomogeneous attrConstruct _ = constructFlowBoxHomogeneous -- VVV Prop "max-children-per-line" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getFlowBoxMaxChildrenPerLine :: (MonadIO m, FlowBoxK o) => o -> m Word32 getFlowBoxMaxChildrenPerLine obj = liftIO $ getObjectPropertyCUInt obj "max-children-per-line" setFlowBoxMaxChildrenPerLine :: (MonadIO m, FlowBoxK o) => o -> Word32 -> m () setFlowBoxMaxChildrenPerLine obj val = liftIO $ setObjectPropertyCUInt obj "max-children-per-line" val constructFlowBoxMaxChildrenPerLine :: Word32 -> IO ([Char], GValue) constructFlowBoxMaxChildrenPerLine val = constructObjectPropertyCUInt "max-children-per-line" val data FlowBoxMaxChildrenPerLinePropertyInfo instance AttrInfo FlowBoxMaxChildrenPerLinePropertyInfo where type AttrAllowedOps FlowBoxMaxChildrenPerLinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FlowBoxMaxChildrenPerLinePropertyInfo = (~) Word32 type AttrBaseTypeConstraint FlowBoxMaxChildrenPerLinePropertyInfo = FlowBoxK type AttrGetType FlowBoxMaxChildrenPerLinePropertyInfo = Word32 type AttrLabel FlowBoxMaxChildrenPerLinePropertyInfo = "FlowBox::max-children-per-line" attrGet _ = getFlowBoxMaxChildrenPerLine attrSet _ = setFlowBoxMaxChildrenPerLine attrConstruct _ = constructFlowBoxMaxChildrenPerLine -- VVV Prop "min-children-per-line" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getFlowBoxMinChildrenPerLine :: (MonadIO m, FlowBoxK o) => o -> m Word32 getFlowBoxMinChildrenPerLine obj = liftIO $ getObjectPropertyCUInt obj "min-children-per-line" setFlowBoxMinChildrenPerLine :: (MonadIO m, FlowBoxK o) => o -> Word32 -> m () setFlowBoxMinChildrenPerLine obj val = liftIO $ setObjectPropertyCUInt obj "min-children-per-line" val constructFlowBoxMinChildrenPerLine :: Word32 -> IO ([Char], GValue) constructFlowBoxMinChildrenPerLine val = constructObjectPropertyCUInt "min-children-per-line" val data FlowBoxMinChildrenPerLinePropertyInfo instance AttrInfo FlowBoxMinChildrenPerLinePropertyInfo where type AttrAllowedOps FlowBoxMinChildrenPerLinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FlowBoxMinChildrenPerLinePropertyInfo = (~) Word32 type AttrBaseTypeConstraint FlowBoxMinChildrenPerLinePropertyInfo = FlowBoxK type AttrGetType FlowBoxMinChildrenPerLinePropertyInfo = Word32 type AttrLabel FlowBoxMinChildrenPerLinePropertyInfo = "FlowBox::min-children-per-line" attrGet _ = getFlowBoxMinChildrenPerLine attrSet _ = setFlowBoxMinChildrenPerLine attrConstruct _ = constructFlowBoxMinChildrenPerLine -- VVV Prop "row-spacing" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getFlowBoxRowSpacing :: (MonadIO m, FlowBoxK o) => o -> m Word32 getFlowBoxRowSpacing obj = liftIO $ getObjectPropertyCUInt obj "row-spacing" setFlowBoxRowSpacing :: (MonadIO m, FlowBoxK o) => o -> Word32 -> m () setFlowBoxRowSpacing obj val = liftIO $ setObjectPropertyCUInt obj "row-spacing" val constructFlowBoxRowSpacing :: Word32 -> IO ([Char], GValue) constructFlowBoxRowSpacing val = constructObjectPropertyCUInt "row-spacing" val data FlowBoxRowSpacingPropertyInfo instance AttrInfo FlowBoxRowSpacingPropertyInfo where type AttrAllowedOps FlowBoxRowSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FlowBoxRowSpacingPropertyInfo = (~) Word32 type AttrBaseTypeConstraint FlowBoxRowSpacingPropertyInfo = FlowBoxK type AttrGetType FlowBoxRowSpacingPropertyInfo = Word32 type AttrLabel FlowBoxRowSpacingPropertyInfo = "FlowBox::row-spacing" attrGet _ = getFlowBoxRowSpacing attrSet _ = setFlowBoxRowSpacing attrConstruct _ = constructFlowBoxRowSpacing -- VVV Prop "selection-mode" -- Type: TInterface "Gtk" "SelectionMode" -- Flags: [PropertyReadable,PropertyWritable] getFlowBoxSelectionMode :: (MonadIO m, FlowBoxK o) => o -> m SelectionMode getFlowBoxSelectionMode obj = liftIO $ getObjectPropertyEnum obj "selection-mode" setFlowBoxSelectionMode :: (MonadIO m, FlowBoxK o) => o -> SelectionMode -> m () setFlowBoxSelectionMode obj val = liftIO $ setObjectPropertyEnum obj "selection-mode" val constructFlowBoxSelectionMode :: SelectionMode -> IO ([Char], GValue) constructFlowBoxSelectionMode val = constructObjectPropertyEnum "selection-mode" val data FlowBoxSelectionModePropertyInfo instance AttrInfo FlowBoxSelectionModePropertyInfo where type AttrAllowedOps FlowBoxSelectionModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FlowBoxSelectionModePropertyInfo = (~) SelectionMode type AttrBaseTypeConstraint FlowBoxSelectionModePropertyInfo = FlowBoxK type AttrGetType FlowBoxSelectionModePropertyInfo = SelectionMode type AttrLabel FlowBoxSelectionModePropertyInfo = "FlowBox::selection-mode" attrGet _ = getFlowBoxSelectionMode attrSet _ = setFlowBoxSelectionMode attrConstruct _ = constructFlowBoxSelectionMode type instance AttributeList FlowBox = '[ '("activate-on-single-click", FlowBoxActivateOnSingleClickPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("column-spacing", FlowBoxColumnSpacingPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", FlowBoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-children-per-line", FlowBoxMaxChildrenPerLinePropertyInfo), '("min-children-per-line", FlowBoxMinChildrenPerLinePropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("row-spacing", FlowBoxRowSpacingPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("selection-mode", FlowBoxSelectionModePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList FlowBoxAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList FlowBoxChild = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList FlowBoxChildAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "font-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getFontButtonFontName :: (MonadIO m, FontButtonK o) => o -> m T.Text getFontButtonFontName obj = liftIO $ getObjectPropertyString obj "font-name" setFontButtonFontName :: (MonadIO m, FontButtonK o) => o -> T.Text -> m () setFontButtonFontName obj val = liftIO $ setObjectPropertyString obj "font-name" val constructFontButtonFontName :: T.Text -> IO ([Char], GValue) constructFontButtonFontName val = constructObjectPropertyString "font-name" val data FontButtonFontNamePropertyInfo instance AttrInfo FontButtonFontNamePropertyInfo where type AttrAllowedOps FontButtonFontNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontButtonFontNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint FontButtonFontNamePropertyInfo = FontButtonK type AttrGetType FontButtonFontNamePropertyInfo = T.Text type AttrLabel FontButtonFontNamePropertyInfo = "FontButton::font-name" attrGet _ = getFontButtonFontName attrSet _ = setFontButtonFontName attrConstruct _ = constructFontButtonFontName -- VVV Prop "show-size" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFontButtonShowSize :: (MonadIO m, FontButtonK o) => o -> m Bool getFontButtonShowSize obj = liftIO $ getObjectPropertyBool obj "show-size" setFontButtonShowSize :: (MonadIO m, FontButtonK o) => o -> Bool -> m () setFontButtonShowSize obj val = liftIO $ setObjectPropertyBool obj "show-size" val constructFontButtonShowSize :: Bool -> IO ([Char], GValue) constructFontButtonShowSize val = constructObjectPropertyBool "show-size" val data FontButtonShowSizePropertyInfo instance AttrInfo FontButtonShowSizePropertyInfo where type AttrAllowedOps FontButtonShowSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontButtonShowSizePropertyInfo = (~) Bool type AttrBaseTypeConstraint FontButtonShowSizePropertyInfo = FontButtonK type AttrGetType FontButtonShowSizePropertyInfo = Bool type AttrLabel FontButtonShowSizePropertyInfo = "FontButton::show-size" attrGet _ = getFontButtonShowSize attrSet _ = setFontButtonShowSize attrConstruct _ = constructFontButtonShowSize -- VVV Prop "show-style" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFontButtonShowStyle :: (MonadIO m, FontButtonK o) => o -> m Bool getFontButtonShowStyle obj = liftIO $ getObjectPropertyBool obj "show-style" setFontButtonShowStyle :: (MonadIO m, FontButtonK o) => o -> Bool -> m () setFontButtonShowStyle obj val = liftIO $ setObjectPropertyBool obj "show-style" val constructFontButtonShowStyle :: Bool -> IO ([Char], GValue) constructFontButtonShowStyle val = constructObjectPropertyBool "show-style" val data FontButtonShowStylePropertyInfo instance AttrInfo FontButtonShowStylePropertyInfo where type AttrAllowedOps FontButtonShowStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontButtonShowStylePropertyInfo = (~) Bool type AttrBaseTypeConstraint FontButtonShowStylePropertyInfo = FontButtonK type AttrGetType FontButtonShowStylePropertyInfo = Bool type AttrLabel FontButtonShowStylePropertyInfo = "FontButton::show-style" attrGet _ = getFontButtonShowStyle attrSet _ = setFontButtonShowStyle attrConstruct _ = constructFontButtonShowStyle -- VVV Prop "title" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getFontButtonTitle :: (MonadIO m, FontButtonK o) => o -> m T.Text getFontButtonTitle obj = liftIO $ getObjectPropertyString obj "title" setFontButtonTitle :: (MonadIO m, FontButtonK o) => o -> T.Text -> m () setFontButtonTitle obj val = liftIO $ setObjectPropertyString obj "title" val constructFontButtonTitle :: T.Text -> IO ([Char], GValue) constructFontButtonTitle val = constructObjectPropertyString "title" val data FontButtonTitlePropertyInfo instance AttrInfo FontButtonTitlePropertyInfo where type AttrAllowedOps FontButtonTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontButtonTitlePropertyInfo = (~) T.Text type AttrBaseTypeConstraint FontButtonTitlePropertyInfo = FontButtonK type AttrGetType FontButtonTitlePropertyInfo = T.Text type AttrLabel FontButtonTitlePropertyInfo = "FontButton::title" attrGet _ = getFontButtonTitle attrSet _ = setFontButtonTitle attrConstruct _ = constructFontButtonTitle -- VVV Prop "use-font" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFontButtonUseFont :: (MonadIO m, FontButtonK o) => o -> m Bool getFontButtonUseFont obj = liftIO $ getObjectPropertyBool obj "use-font" setFontButtonUseFont :: (MonadIO m, FontButtonK o) => o -> Bool -> m () setFontButtonUseFont obj val = liftIO $ setObjectPropertyBool obj "use-font" val constructFontButtonUseFont :: Bool -> IO ([Char], GValue) constructFontButtonUseFont val = constructObjectPropertyBool "use-font" val data FontButtonUseFontPropertyInfo instance AttrInfo FontButtonUseFontPropertyInfo where type AttrAllowedOps FontButtonUseFontPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontButtonUseFontPropertyInfo = (~) Bool type AttrBaseTypeConstraint FontButtonUseFontPropertyInfo = FontButtonK type AttrGetType FontButtonUseFontPropertyInfo = Bool type AttrLabel FontButtonUseFontPropertyInfo = "FontButton::use-font" attrGet _ = getFontButtonUseFont attrSet _ = setFontButtonUseFont attrConstruct _ = constructFontButtonUseFont -- VVV Prop "use-size" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFontButtonUseSize :: (MonadIO m, FontButtonK o) => o -> m Bool getFontButtonUseSize obj = liftIO $ getObjectPropertyBool obj "use-size" setFontButtonUseSize :: (MonadIO m, FontButtonK o) => o -> Bool -> m () setFontButtonUseSize obj val = liftIO $ setObjectPropertyBool obj "use-size" val constructFontButtonUseSize :: Bool -> IO ([Char], GValue) constructFontButtonUseSize val = constructObjectPropertyBool "use-size" val data FontButtonUseSizePropertyInfo instance AttrInfo FontButtonUseSizePropertyInfo where type AttrAllowedOps FontButtonUseSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontButtonUseSizePropertyInfo = (~) Bool type AttrBaseTypeConstraint FontButtonUseSizePropertyInfo = FontButtonK type AttrGetType FontButtonUseSizePropertyInfo = Bool type AttrLabel FontButtonUseSizePropertyInfo = "FontButton::use-size" attrGet _ = getFontButtonUseSize attrSet _ = setFontButtonUseSize attrConstruct _ = constructFontButtonUseSize type instance AttributeList FontButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("font", FontChooserFontPropertyInfo), '("font-desc", FontChooserFontDescPropertyInfo), '("font-name", FontButtonFontNamePropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("preview-text", FontChooserPreviewTextPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-preview-entry", FontChooserShowPreviewEntryPropertyInfo), '("show-size", FontButtonShowSizePropertyInfo), '("show-style", FontButtonShowStylePropertyInfo), '("style", WidgetStylePropertyInfo), '("title", FontButtonTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-font", FontButtonUseFontPropertyInfo), '("use-size", FontButtonUseSizePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] -- VVV Prop "font" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getFontChooserFont :: (MonadIO m, FontChooserK o) => o -> m T.Text getFontChooserFont obj = liftIO $ getObjectPropertyString obj "font" setFontChooserFont :: (MonadIO m, FontChooserK o) => o -> T.Text -> m () setFontChooserFont obj val = liftIO $ setObjectPropertyString obj "font" val constructFontChooserFont :: T.Text -> IO ([Char], GValue) constructFontChooserFont val = constructObjectPropertyString "font" val data FontChooserFontPropertyInfo instance AttrInfo FontChooserFontPropertyInfo where type AttrAllowedOps FontChooserFontPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontChooserFontPropertyInfo = (~) T.Text type AttrBaseTypeConstraint FontChooserFontPropertyInfo = FontChooserK type AttrGetType FontChooserFontPropertyInfo = T.Text type AttrLabel FontChooserFontPropertyInfo = "FontChooser::font" attrGet _ = getFontChooserFont attrSet _ = setFontChooserFont attrConstruct _ = constructFontChooserFont -- VVV Prop "font-desc" -- Type: TInterface "Pango" "FontDescription" -- Flags: [PropertyReadable,PropertyWritable] getFontChooserFontDesc :: (MonadIO m, FontChooserK o) => o -> m Pango.FontDescription getFontChooserFontDesc obj = liftIO $ getObjectPropertyBoxed obj "font-desc" Pango.FontDescription setFontChooserFontDesc :: (MonadIO m, FontChooserK o) => o -> Pango.FontDescription -> m () setFontChooserFontDesc obj val = liftIO $ setObjectPropertyBoxed obj "font-desc" val constructFontChooserFontDesc :: Pango.FontDescription -> IO ([Char], GValue) constructFontChooserFontDesc val = constructObjectPropertyBoxed "font-desc" val data FontChooserFontDescPropertyInfo instance AttrInfo FontChooserFontDescPropertyInfo where type AttrAllowedOps FontChooserFontDescPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontChooserFontDescPropertyInfo = (~) Pango.FontDescription type AttrBaseTypeConstraint FontChooserFontDescPropertyInfo = FontChooserK type AttrGetType FontChooserFontDescPropertyInfo = Pango.FontDescription type AttrLabel FontChooserFontDescPropertyInfo = "FontChooser::font-desc" attrGet _ = getFontChooserFontDesc attrSet _ = setFontChooserFontDesc attrConstruct _ = constructFontChooserFontDesc -- VVV Prop "preview-text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getFontChooserPreviewText :: (MonadIO m, FontChooserK o) => o -> m T.Text getFontChooserPreviewText obj = liftIO $ getObjectPropertyString obj "preview-text" setFontChooserPreviewText :: (MonadIO m, FontChooserK o) => o -> T.Text -> m () setFontChooserPreviewText obj val = liftIO $ setObjectPropertyString obj "preview-text" val constructFontChooserPreviewText :: T.Text -> IO ([Char], GValue) constructFontChooserPreviewText val = constructObjectPropertyString "preview-text" val data FontChooserPreviewTextPropertyInfo instance AttrInfo FontChooserPreviewTextPropertyInfo where type AttrAllowedOps FontChooserPreviewTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontChooserPreviewTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint FontChooserPreviewTextPropertyInfo = FontChooserK type AttrGetType FontChooserPreviewTextPropertyInfo = T.Text type AttrLabel FontChooserPreviewTextPropertyInfo = "FontChooser::preview-text" attrGet _ = getFontChooserPreviewText attrSet _ = setFontChooserPreviewText attrConstruct _ = constructFontChooserPreviewText -- VVV Prop "show-preview-entry" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getFontChooserShowPreviewEntry :: (MonadIO m, FontChooserK o) => o -> m Bool getFontChooserShowPreviewEntry obj = liftIO $ getObjectPropertyBool obj "show-preview-entry" setFontChooserShowPreviewEntry :: (MonadIO m, FontChooserK o) => o -> Bool -> m () setFontChooserShowPreviewEntry obj val = liftIO $ setObjectPropertyBool obj "show-preview-entry" val constructFontChooserShowPreviewEntry :: Bool -> IO ([Char], GValue) constructFontChooserShowPreviewEntry val = constructObjectPropertyBool "show-preview-entry" val data FontChooserShowPreviewEntryPropertyInfo instance AttrInfo FontChooserShowPreviewEntryPropertyInfo where type AttrAllowedOps FontChooserShowPreviewEntryPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontChooserShowPreviewEntryPropertyInfo = (~) Bool type AttrBaseTypeConstraint FontChooserShowPreviewEntryPropertyInfo = FontChooserK type AttrGetType FontChooserShowPreviewEntryPropertyInfo = Bool type AttrLabel FontChooserShowPreviewEntryPropertyInfo = "FontChooser::show-preview-entry" attrGet _ = getFontChooserShowPreviewEntry attrSet _ = setFontChooserShowPreviewEntry attrConstruct _ = constructFontChooserShowPreviewEntry type instance AttributeList FontChooser = '[ '("font", FontChooserFontPropertyInfo), '("font-desc", FontChooserFontDescPropertyInfo), '("preview-text", FontChooserPreviewTextPropertyInfo), '("show-preview-entry", FontChooserShowPreviewEntryPropertyInfo)] type instance AttributeList FontChooserDialog = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("font", FontChooserFontPropertyInfo), '("font-desc", FontChooserFontDescPropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("preview-text", FontChooserPreviewTextPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-preview-entry", FontChooserShowPreviewEntryPropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-header-bar", DialogUseHeaderBarPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] type instance AttributeList FontChooserWidget = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("font", FontChooserFontPropertyInfo), '("font-desc", FontChooserFontDescPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("preview-text", FontChooserPreviewTextPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-preview-entry", FontChooserShowPreviewEntryPropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "font-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getFontSelectionFontName :: (MonadIO m, FontSelectionK o) => o -> m T.Text getFontSelectionFontName obj = liftIO $ getObjectPropertyString obj "font-name" setFontSelectionFontName :: (MonadIO m, FontSelectionK o) => o -> T.Text -> m () setFontSelectionFontName obj val = liftIO $ setObjectPropertyString obj "font-name" val constructFontSelectionFontName :: T.Text -> IO ([Char], GValue) constructFontSelectionFontName val = constructObjectPropertyString "font-name" val data FontSelectionFontNamePropertyInfo instance AttrInfo FontSelectionFontNamePropertyInfo where type AttrAllowedOps FontSelectionFontNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontSelectionFontNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint FontSelectionFontNamePropertyInfo = FontSelectionK type AttrGetType FontSelectionFontNamePropertyInfo = T.Text type AttrLabel FontSelectionFontNamePropertyInfo = "FontSelection::font-name" attrGet _ = getFontSelectionFontName attrSet _ = setFontSelectionFontName attrConstruct _ = constructFontSelectionFontName -- VVV Prop "preview-text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getFontSelectionPreviewText :: (MonadIO m, FontSelectionK o) => o -> m T.Text getFontSelectionPreviewText obj = liftIO $ getObjectPropertyString obj "preview-text" setFontSelectionPreviewText :: (MonadIO m, FontSelectionK o) => o -> T.Text -> m () setFontSelectionPreviewText obj val = liftIO $ setObjectPropertyString obj "preview-text" val constructFontSelectionPreviewText :: T.Text -> IO ([Char], GValue) constructFontSelectionPreviewText val = constructObjectPropertyString "preview-text" val data FontSelectionPreviewTextPropertyInfo instance AttrInfo FontSelectionPreviewTextPropertyInfo where type AttrAllowedOps FontSelectionPreviewTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FontSelectionPreviewTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint FontSelectionPreviewTextPropertyInfo = FontSelectionK type AttrGetType FontSelectionPreviewTextPropertyInfo = T.Text type AttrLabel FontSelectionPreviewTextPropertyInfo = "FontSelection::preview-text" attrGet _ = getFontSelectionPreviewText attrSet _ = setFontSelectionPreviewText attrConstruct _ = constructFontSelectionPreviewText type instance AttributeList FontSelection = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("font-name", FontSelectionFontNamePropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("preview-text", FontSelectionPreviewTextPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList FontSelectionDialog = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-header-bar", DialogUseHeaderBarPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] -- VVV Prop "label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getFrameLabel :: (MonadIO m, FrameK o) => o -> m T.Text getFrameLabel obj = liftIO $ getObjectPropertyString obj "label" setFrameLabel :: (MonadIO m, FrameK o) => o -> T.Text -> m () setFrameLabel obj val = liftIO $ setObjectPropertyString obj "label" val constructFrameLabel :: T.Text -> IO ([Char], GValue) constructFrameLabel val = constructObjectPropertyString "label" val data FrameLabelPropertyInfo instance AttrInfo FrameLabelPropertyInfo where type AttrAllowedOps FrameLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FrameLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint FrameLabelPropertyInfo = FrameK type AttrGetType FrameLabelPropertyInfo = T.Text type AttrLabel FrameLabelPropertyInfo = "Frame::label" attrGet _ = getFrameLabel attrSet _ = setFrameLabel attrConstruct _ = constructFrameLabel -- VVV Prop "label-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getFrameLabelWidget :: (MonadIO m, FrameK o) => o -> m Widget getFrameLabelWidget obj = liftIO $ getObjectPropertyObject obj "label-widget" Widget setFrameLabelWidget :: (MonadIO m, FrameK o, WidgetK a) => o -> a -> m () setFrameLabelWidget obj val = liftIO $ setObjectPropertyObject obj "label-widget" val constructFrameLabelWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructFrameLabelWidget val = constructObjectPropertyObject "label-widget" val data FrameLabelWidgetPropertyInfo instance AttrInfo FrameLabelWidgetPropertyInfo where type AttrAllowedOps FrameLabelWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FrameLabelWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint FrameLabelWidgetPropertyInfo = FrameK type AttrGetType FrameLabelWidgetPropertyInfo = Widget type AttrLabel FrameLabelWidgetPropertyInfo = "Frame::label-widget" attrGet _ = getFrameLabelWidget attrSet _ = setFrameLabelWidget attrConstruct _ = constructFrameLabelWidget -- VVV Prop "label-xalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getFrameLabelXalign :: (MonadIO m, FrameK o) => o -> m Float getFrameLabelXalign obj = liftIO $ getObjectPropertyFloat obj "label-xalign" setFrameLabelXalign :: (MonadIO m, FrameK o) => o -> Float -> m () setFrameLabelXalign obj val = liftIO $ setObjectPropertyFloat obj "label-xalign" val constructFrameLabelXalign :: Float -> IO ([Char], GValue) constructFrameLabelXalign val = constructObjectPropertyFloat "label-xalign" val data FrameLabelXalignPropertyInfo instance AttrInfo FrameLabelXalignPropertyInfo where type AttrAllowedOps FrameLabelXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FrameLabelXalignPropertyInfo = (~) Float type AttrBaseTypeConstraint FrameLabelXalignPropertyInfo = FrameK type AttrGetType FrameLabelXalignPropertyInfo = Float type AttrLabel FrameLabelXalignPropertyInfo = "Frame::label-xalign" attrGet _ = getFrameLabelXalign attrSet _ = setFrameLabelXalign attrConstruct _ = constructFrameLabelXalign -- VVV Prop "label-yalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getFrameLabelYalign :: (MonadIO m, FrameK o) => o -> m Float getFrameLabelYalign obj = liftIO $ getObjectPropertyFloat obj "label-yalign" setFrameLabelYalign :: (MonadIO m, FrameK o) => o -> Float -> m () setFrameLabelYalign obj val = liftIO $ setObjectPropertyFloat obj "label-yalign" val constructFrameLabelYalign :: Float -> IO ([Char], GValue) constructFrameLabelYalign val = constructObjectPropertyFloat "label-yalign" val data FrameLabelYalignPropertyInfo instance AttrInfo FrameLabelYalignPropertyInfo where type AttrAllowedOps FrameLabelYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FrameLabelYalignPropertyInfo = (~) Float type AttrBaseTypeConstraint FrameLabelYalignPropertyInfo = FrameK type AttrGetType FrameLabelYalignPropertyInfo = Float type AttrLabel FrameLabelYalignPropertyInfo = "Frame::label-yalign" attrGet _ = getFrameLabelYalign attrSet _ = setFrameLabelYalign attrConstruct _ = constructFrameLabelYalign -- VVV Prop "shadow-type" -- Type: TInterface "Gtk" "ShadowType" -- Flags: [PropertyReadable,PropertyWritable] getFrameShadowType :: (MonadIO m, FrameK o) => o -> m ShadowType getFrameShadowType obj = liftIO $ getObjectPropertyEnum obj "shadow-type" setFrameShadowType :: (MonadIO m, FrameK o) => o -> ShadowType -> m () setFrameShadowType obj val = liftIO $ setObjectPropertyEnum obj "shadow-type" val constructFrameShadowType :: ShadowType -> IO ([Char], GValue) constructFrameShadowType val = constructObjectPropertyEnum "shadow-type" val data FrameShadowTypePropertyInfo instance AttrInfo FrameShadowTypePropertyInfo where type AttrAllowedOps FrameShadowTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FrameShadowTypePropertyInfo = (~) ShadowType type AttrBaseTypeConstraint FrameShadowTypePropertyInfo = FrameK type AttrGetType FrameShadowTypePropertyInfo = ShadowType type AttrLabel FrameShadowTypePropertyInfo = "Frame::shadow-type" attrGet _ = getFrameShadowType attrSet _ = setFrameShadowType attrConstruct _ = constructFrameShadowType type instance AttributeList Frame = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", FrameLabelPropertyInfo), '("label-widget", FrameLabelWidgetPropertyInfo), '("label-xalign", FrameLabelXalignPropertyInfo), '("label-yalign", FrameLabelYalignPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", FrameShadowTypePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList FrameAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "auto-render" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getGLAreaAutoRender :: (MonadIO m, GLAreaK o) => o -> m Bool getGLAreaAutoRender obj = liftIO $ getObjectPropertyBool obj "auto-render" setGLAreaAutoRender :: (MonadIO m, GLAreaK o) => o -> Bool -> m () setGLAreaAutoRender obj val = liftIO $ setObjectPropertyBool obj "auto-render" val constructGLAreaAutoRender :: Bool -> IO ([Char], GValue) constructGLAreaAutoRender val = constructObjectPropertyBool "auto-render" val data GLAreaAutoRenderPropertyInfo instance AttrInfo GLAreaAutoRenderPropertyInfo where type AttrAllowedOps GLAreaAutoRenderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GLAreaAutoRenderPropertyInfo = (~) Bool type AttrBaseTypeConstraint GLAreaAutoRenderPropertyInfo = GLAreaK type AttrGetType GLAreaAutoRenderPropertyInfo = Bool type AttrLabel GLAreaAutoRenderPropertyInfo = "GLArea::auto-render" attrGet _ = getGLAreaAutoRender attrSet _ = setGLAreaAutoRender attrConstruct _ = constructGLAreaAutoRender -- VVV Prop "context" -- Type: TInterface "Gdk" "GLContext" -- Flags: [PropertyReadable] getGLAreaContext :: (MonadIO m, GLAreaK o) => o -> m Gdk.GLContext getGLAreaContext obj = liftIO $ getObjectPropertyObject obj "context" Gdk.GLContext data GLAreaContextPropertyInfo instance AttrInfo GLAreaContextPropertyInfo where type AttrAllowedOps GLAreaContextPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint GLAreaContextPropertyInfo = (~) () type AttrBaseTypeConstraint GLAreaContextPropertyInfo = GLAreaK type AttrGetType GLAreaContextPropertyInfo = Gdk.GLContext type AttrLabel GLAreaContextPropertyInfo = "GLArea::context" attrGet _ = getGLAreaContext attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "has-alpha" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getGLAreaHasAlpha :: (MonadIO m, GLAreaK o) => o -> m Bool getGLAreaHasAlpha obj = liftIO $ getObjectPropertyBool obj "has-alpha" setGLAreaHasAlpha :: (MonadIO m, GLAreaK o) => o -> Bool -> m () setGLAreaHasAlpha obj val = liftIO $ setObjectPropertyBool obj "has-alpha" val constructGLAreaHasAlpha :: Bool -> IO ([Char], GValue) constructGLAreaHasAlpha val = constructObjectPropertyBool "has-alpha" val data GLAreaHasAlphaPropertyInfo instance AttrInfo GLAreaHasAlphaPropertyInfo where type AttrAllowedOps GLAreaHasAlphaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GLAreaHasAlphaPropertyInfo = (~) Bool type AttrBaseTypeConstraint GLAreaHasAlphaPropertyInfo = GLAreaK type AttrGetType GLAreaHasAlphaPropertyInfo = Bool type AttrLabel GLAreaHasAlphaPropertyInfo = "GLArea::has-alpha" attrGet _ = getGLAreaHasAlpha attrSet _ = setGLAreaHasAlpha attrConstruct _ = constructGLAreaHasAlpha -- VVV Prop "has-depth-buffer" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getGLAreaHasDepthBuffer :: (MonadIO m, GLAreaK o) => o -> m Bool getGLAreaHasDepthBuffer obj = liftIO $ getObjectPropertyBool obj "has-depth-buffer" setGLAreaHasDepthBuffer :: (MonadIO m, GLAreaK o) => o -> Bool -> m () setGLAreaHasDepthBuffer obj val = liftIO $ setObjectPropertyBool obj "has-depth-buffer" val constructGLAreaHasDepthBuffer :: Bool -> IO ([Char], GValue) constructGLAreaHasDepthBuffer val = constructObjectPropertyBool "has-depth-buffer" val data GLAreaHasDepthBufferPropertyInfo instance AttrInfo GLAreaHasDepthBufferPropertyInfo where type AttrAllowedOps GLAreaHasDepthBufferPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GLAreaHasDepthBufferPropertyInfo = (~) Bool type AttrBaseTypeConstraint GLAreaHasDepthBufferPropertyInfo = GLAreaK type AttrGetType GLAreaHasDepthBufferPropertyInfo = Bool type AttrLabel GLAreaHasDepthBufferPropertyInfo = "GLArea::has-depth-buffer" attrGet _ = getGLAreaHasDepthBuffer attrSet _ = setGLAreaHasDepthBuffer attrConstruct _ = constructGLAreaHasDepthBuffer -- VVV Prop "has-stencil-buffer" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getGLAreaHasStencilBuffer :: (MonadIO m, GLAreaK o) => o -> m Bool getGLAreaHasStencilBuffer obj = liftIO $ getObjectPropertyBool obj "has-stencil-buffer" setGLAreaHasStencilBuffer :: (MonadIO m, GLAreaK o) => o -> Bool -> m () setGLAreaHasStencilBuffer obj val = liftIO $ setObjectPropertyBool obj "has-stencil-buffer" val constructGLAreaHasStencilBuffer :: Bool -> IO ([Char], GValue) constructGLAreaHasStencilBuffer val = constructObjectPropertyBool "has-stencil-buffer" val data GLAreaHasStencilBufferPropertyInfo instance AttrInfo GLAreaHasStencilBufferPropertyInfo where type AttrAllowedOps GLAreaHasStencilBufferPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GLAreaHasStencilBufferPropertyInfo = (~) Bool type AttrBaseTypeConstraint GLAreaHasStencilBufferPropertyInfo = GLAreaK type AttrGetType GLAreaHasStencilBufferPropertyInfo = Bool type AttrLabel GLAreaHasStencilBufferPropertyInfo = "GLArea::has-stencil-buffer" attrGet _ = getGLAreaHasStencilBuffer attrSet _ = setGLAreaHasStencilBuffer attrConstruct _ = constructGLAreaHasStencilBuffer type instance AttributeList GLArea = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("auto-render", GLAreaAutoRenderPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("context", GLAreaContextPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-alpha", GLAreaHasAlphaPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-depth-buffer", GLAreaHasDepthBufferPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-stencil-buffer", GLAreaHasStencilBufferPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "n-points" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getGestureNPoints :: (MonadIO m, GestureK o) => o -> m Word32 getGestureNPoints obj = liftIO $ getObjectPropertyCUInt obj "n-points" constructGestureNPoints :: Word32 -> IO ([Char], GValue) constructGestureNPoints val = constructObjectPropertyCUInt "n-points" val data GestureNPointsPropertyInfo instance AttrInfo GestureNPointsPropertyInfo where type AttrAllowedOps GestureNPointsPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GestureNPointsPropertyInfo = (~) Word32 type AttrBaseTypeConstraint GestureNPointsPropertyInfo = GestureK type AttrGetType GestureNPointsPropertyInfo = Word32 type AttrLabel GestureNPointsPropertyInfo = "Gesture::n-points" attrGet _ = getGestureNPoints attrSet _ = undefined attrConstruct _ = constructGestureNPoints -- VVV Prop "window" -- Type: TInterface "Gdk" "Window" -- Flags: [PropertyReadable,PropertyWritable] getGestureWindow :: (MonadIO m, GestureK o) => o -> m Gdk.Window getGestureWindow obj = liftIO $ getObjectPropertyObject obj "window" Gdk.Window setGestureWindow :: (MonadIO m, GestureK o, Gdk.WindowK a) => o -> a -> m () setGestureWindow obj val = liftIO $ setObjectPropertyObject obj "window" val constructGestureWindow :: (Gdk.WindowK a) => a -> IO ([Char], GValue) constructGestureWindow val = constructObjectPropertyObject "window" val data GestureWindowPropertyInfo instance AttrInfo GestureWindowPropertyInfo where type AttrAllowedOps GestureWindowPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GestureWindowPropertyInfo = Gdk.WindowK type AttrBaseTypeConstraint GestureWindowPropertyInfo = GestureK type AttrGetType GestureWindowPropertyInfo = Gdk.Window type AttrLabel GestureWindowPropertyInfo = "Gesture::window" attrGet _ = getGestureWindow attrSet _ = setGestureWindow attrConstruct _ = constructGestureWindow type instance AttributeList Gesture = '[ '("n-points", GestureNPointsPropertyInfo), '("propagation-phase", EventControllerPropagationPhasePropertyInfo), '("widget", EventControllerWidgetPropertyInfo), '("window", GestureWindowPropertyInfo)] type instance AttributeList GestureDrag = '[ '("button", GestureSingleButtonPropertyInfo), '("exclusive", GestureSingleExclusivePropertyInfo), '("n-points", GestureNPointsPropertyInfo), '("propagation-phase", EventControllerPropagationPhasePropertyInfo), '("touch-only", GestureSingleTouchOnlyPropertyInfo), '("widget", EventControllerWidgetPropertyInfo), '("window", GestureWindowPropertyInfo)] -- VVV Prop "delay-factor" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getGestureLongPressDelayFactor :: (MonadIO m, GestureLongPressK o) => o -> m Double getGestureLongPressDelayFactor obj = liftIO $ getObjectPropertyDouble obj "delay-factor" setGestureLongPressDelayFactor :: (MonadIO m, GestureLongPressK o) => o -> Double -> m () setGestureLongPressDelayFactor obj val = liftIO $ setObjectPropertyDouble obj "delay-factor" val constructGestureLongPressDelayFactor :: Double -> IO ([Char], GValue) constructGestureLongPressDelayFactor val = constructObjectPropertyDouble "delay-factor" val data GestureLongPressDelayFactorPropertyInfo instance AttrInfo GestureLongPressDelayFactorPropertyInfo where type AttrAllowedOps GestureLongPressDelayFactorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GestureLongPressDelayFactorPropertyInfo = (~) Double type AttrBaseTypeConstraint GestureLongPressDelayFactorPropertyInfo = GestureLongPressK type AttrGetType GestureLongPressDelayFactorPropertyInfo = Double type AttrLabel GestureLongPressDelayFactorPropertyInfo = "GestureLongPress::delay-factor" attrGet _ = getGestureLongPressDelayFactor attrSet _ = setGestureLongPressDelayFactor attrConstruct _ = constructGestureLongPressDelayFactor type instance AttributeList GestureLongPress = '[ '("button", GestureSingleButtonPropertyInfo), '("delay-factor", GestureLongPressDelayFactorPropertyInfo), '("exclusive", GestureSingleExclusivePropertyInfo), '("n-points", GestureNPointsPropertyInfo), '("propagation-phase", EventControllerPropagationPhasePropertyInfo), '("touch-only", GestureSingleTouchOnlyPropertyInfo), '("widget", EventControllerWidgetPropertyInfo), '("window", GestureWindowPropertyInfo)] type instance AttributeList GestureMultiPress = '[ '("button", GestureSingleButtonPropertyInfo), '("exclusive", GestureSingleExclusivePropertyInfo), '("n-points", GestureNPointsPropertyInfo), '("propagation-phase", EventControllerPropagationPhasePropertyInfo), '("touch-only", GestureSingleTouchOnlyPropertyInfo), '("widget", EventControllerWidgetPropertyInfo), '("window", GestureWindowPropertyInfo)] -- VVV Prop "orientation" -- Type: TInterface "Gtk" "Orientation" -- Flags: [PropertyReadable,PropertyWritable] getGesturePanOrientation :: (MonadIO m, GesturePanK o) => o -> m Orientation getGesturePanOrientation obj = liftIO $ getObjectPropertyEnum obj "orientation" setGesturePanOrientation :: (MonadIO m, GesturePanK o) => o -> Orientation -> m () setGesturePanOrientation obj val = liftIO $ setObjectPropertyEnum obj "orientation" val constructGesturePanOrientation :: Orientation -> IO ([Char], GValue) constructGesturePanOrientation val = constructObjectPropertyEnum "orientation" val data GesturePanOrientationPropertyInfo instance AttrInfo GesturePanOrientationPropertyInfo where type AttrAllowedOps GesturePanOrientationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GesturePanOrientationPropertyInfo = (~) Orientation type AttrBaseTypeConstraint GesturePanOrientationPropertyInfo = GesturePanK type AttrGetType GesturePanOrientationPropertyInfo = Orientation type AttrLabel GesturePanOrientationPropertyInfo = "GesturePan::orientation" attrGet _ = getGesturePanOrientation attrSet _ = setGesturePanOrientation attrConstruct _ = constructGesturePanOrientation type instance AttributeList GesturePan = '[ '("button", GestureSingleButtonPropertyInfo), '("exclusive", GestureSingleExclusivePropertyInfo), '("n-points", GestureNPointsPropertyInfo), '("orientation", GesturePanOrientationPropertyInfo), '("propagation-phase", EventControllerPropagationPhasePropertyInfo), '("touch-only", GestureSingleTouchOnlyPropertyInfo), '("widget", EventControllerWidgetPropertyInfo), '("window", GestureWindowPropertyInfo)] type instance AttributeList GestureRotate = '[ '("n-points", GestureNPointsPropertyInfo), '("propagation-phase", EventControllerPropagationPhasePropertyInfo), '("widget", EventControllerWidgetPropertyInfo), '("window", GestureWindowPropertyInfo)] -- VVV Prop "button" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getGestureSingleButton :: (MonadIO m, GestureSingleK o) => o -> m Word32 getGestureSingleButton obj = liftIO $ getObjectPropertyCUInt obj "button" setGestureSingleButton :: (MonadIO m, GestureSingleK o) => o -> Word32 -> m () setGestureSingleButton obj val = liftIO $ setObjectPropertyCUInt obj "button" val constructGestureSingleButton :: Word32 -> IO ([Char], GValue) constructGestureSingleButton val = constructObjectPropertyCUInt "button" val data GestureSingleButtonPropertyInfo instance AttrInfo GestureSingleButtonPropertyInfo where type AttrAllowedOps GestureSingleButtonPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GestureSingleButtonPropertyInfo = (~) Word32 type AttrBaseTypeConstraint GestureSingleButtonPropertyInfo = GestureSingleK type AttrGetType GestureSingleButtonPropertyInfo = Word32 type AttrLabel GestureSingleButtonPropertyInfo = "GestureSingle::button" attrGet _ = getGestureSingleButton attrSet _ = setGestureSingleButton attrConstruct _ = constructGestureSingleButton -- VVV Prop "exclusive" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getGestureSingleExclusive :: (MonadIO m, GestureSingleK o) => o -> m Bool getGestureSingleExclusive obj = liftIO $ getObjectPropertyBool obj "exclusive" setGestureSingleExclusive :: (MonadIO m, GestureSingleK o) => o -> Bool -> m () setGestureSingleExclusive obj val = liftIO $ setObjectPropertyBool obj "exclusive" val constructGestureSingleExclusive :: Bool -> IO ([Char], GValue) constructGestureSingleExclusive val = constructObjectPropertyBool "exclusive" val data GestureSingleExclusivePropertyInfo instance AttrInfo GestureSingleExclusivePropertyInfo where type AttrAllowedOps GestureSingleExclusivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GestureSingleExclusivePropertyInfo = (~) Bool type AttrBaseTypeConstraint GestureSingleExclusivePropertyInfo = GestureSingleK type AttrGetType GestureSingleExclusivePropertyInfo = Bool type AttrLabel GestureSingleExclusivePropertyInfo = "GestureSingle::exclusive" attrGet _ = getGestureSingleExclusive attrSet _ = setGestureSingleExclusive attrConstruct _ = constructGestureSingleExclusive -- VVV Prop "touch-only" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getGestureSingleTouchOnly :: (MonadIO m, GestureSingleK o) => o -> m Bool getGestureSingleTouchOnly obj = liftIO $ getObjectPropertyBool obj "touch-only" setGestureSingleTouchOnly :: (MonadIO m, GestureSingleK o) => o -> Bool -> m () setGestureSingleTouchOnly obj val = liftIO $ setObjectPropertyBool obj "touch-only" val constructGestureSingleTouchOnly :: Bool -> IO ([Char], GValue) constructGestureSingleTouchOnly val = constructObjectPropertyBool "touch-only" val data GestureSingleTouchOnlyPropertyInfo instance AttrInfo GestureSingleTouchOnlyPropertyInfo where type AttrAllowedOps GestureSingleTouchOnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GestureSingleTouchOnlyPropertyInfo = (~) Bool type AttrBaseTypeConstraint GestureSingleTouchOnlyPropertyInfo = GestureSingleK type AttrGetType GestureSingleTouchOnlyPropertyInfo = Bool type AttrLabel GestureSingleTouchOnlyPropertyInfo = "GestureSingle::touch-only" attrGet _ = getGestureSingleTouchOnly attrSet _ = setGestureSingleTouchOnly attrConstruct _ = constructGestureSingleTouchOnly type instance AttributeList GestureSingle = '[ '("button", GestureSingleButtonPropertyInfo), '("exclusive", GestureSingleExclusivePropertyInfo), '("n-points", GestureNPointsPropertyInfo), '("propagation-phase", EventControllerPropagationPhasePropertyInfo), '("touch-only", GestureSingleTouchOnlyPropertyInfo), '("widget", EventControllerWidgetPropertyInfo), '("window", GestureWindowPropertyInfo)] type instance AttributeList GestureSwipe = '[ '("button", GestureSingleButtonPropertyInfo), '("exclusive", GestureSingleExclusivePropertyInfo), '("n-points", GestureNPointsPropertyInfo), '("propagation-phase", EventControllerPropagationPhasePropertyInfo), '("touch-only", GestureSingleTouchOnlyPropertyInfo), '("widget", EventControllerWidgetPropertyInfo), '("window", GestureWindowPropertyInfo)] type instance AttributeList GestureZoom = '[ '("n-points", GestureNPointsPropertyInfo), '("propagation-phase", EventControllerPropagationPhasePropertyInfo), '("widget", EventControllerWidgetPropertyInfo), '("window", GestureWindowPropertyInfo)] -- VVV Prop "baseline-row" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getGridBaselineRow :: (MonadIO m, GridK o) => o -> m Int32 getGridBaselineRow obj = liftIO $ getObjectPropertyCInt obj "baseline-row" setGridBaselineRow :: (MonadIO m, GridK o) => o -> Int32 -> m () setGridBaselineRow obj val = liftIO $ setObjectPropertyCInt obj "baseline-row" val constructGridBaselineRow :: Int32 -> IO ([Char], GValue) constructGridBaselineRow val = constructObjectPropertyCInt "baseline-row" val data GridBaselineRowPropertyInfo instance AttrInfo GridBaselineRowPropertyInfo where type AttrAllowedOps GridBaselineRowPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GridBaselineRowPropertyInfo = (~) Int32 type AttrBaseTypeConstraint GridBaselineRowPropertyInfo = GridK type AttrGetType GridBaselineRowPropertyInfo = Int32 type AttrLabel GridBaselineRowPropertyInfo = "Grid::baseline-row" attrGet _ = getGridBaselineRow attrSet _ = setGridBaselineRow attrConstruct _ = constructGridBaselineRow -- VVV Prop "column-homogeneous" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getGridColumnHomogeneous :: (MonadIO m, GridK o) => o -> m Bool getGridColumnHomogeneous obj = liftIO $ getObjectPropertyBool obj "column-homogeneous" setGridColumnHomogeneous :: (MonadIO m, GridK o) => o -> Bool -> m () setGridColumnHomogeneous obj val = liftIO $ setObjectPropertyBool obj "column-homogeneous" val constructGridColumnHomogeneous :: Bool -> IO ([Char], GValue) constructGridColumnHomogeneous val = constructObjectPropertyBool "column-homogeneous" val data GridColumnHomogeneousPropertyInfo instance AttrInfo GridColumnHomogeneousPropertyInfo where type AttrAllowedOps GridColumnHomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GridColumnHomogeneousPropertyInfo = (~) Bool type AttrBaseTypeConstraint GridColumnHomogeneousPropertyInfo = GridK type AttrGetType GridColumnHomogeneousPropertyInfo = Bool type AttrLabel GridColumnHomogeneousPropertyInfo = "Grid::column-homogeneous" attrGet _ = getGridColumnHomogeneous attrSet _ = setGridColumnHomogeneous attrConstruct _ = constructGridColumnHomogeneous -- VVV Prop "column-spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getGridColumnSpacing :: (MonadIO m, GridK o) => o -> m Int32 getGridColumnSpacing obj = liftIO $ getObjectPropertyCInt obj "column-spacing" setGridColumnSpacing :: (MonadIO m, GridK o) => o -> Int32 -> m () setGridColumnSpacing obj val = liftIO $ setObjectPropertyCInt obj "column-spacing" val constructGridColumnSpacing :: Int32 -> IO ([Char], GValue) constructGridColumnSpacing val = constructObjectPropertyCInt "column-spacing" val data GridColumnSpacingPropertyInfo instance AttrInfo GridColumnSpacingPropertyInfo where type AttrAllowedOps GridColumnSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GridColumnSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint GridColumnSpacingPropertyInfo = GridK type AttrGetType GridColumnSpacingPropertyInfo = Int32 type AttrLabel GridColumnSpacingPropertyInfo = "Grid::column-spacing" attrGet _ = getGridColumnSpacing attrSet _ = setGridColumnSpacing attrConstruct _ = constructGridColumnSpacing -- VVV Prop "row-homogeneous" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getGridRowHomogeneous :: (MonadIO m, GridK o) => o -> m Bool getGridRowHomogeneous obj = liftIO $ getObjectPropertyBool obj "row-homogeneous" setGridRowHomogeneous :: (MonadIO m, GridK o) => o -> Bool -> m () setGridRowHomogeneous obj val = liftIO $ setObjectPropertyBool obj "row-homogeneous" val constructGridRowHomogeneous :: Bool -> IO ([Char], GValue) constructGridRowHomogeneous val = constructObjectPropertyBool "row-homogeneous" val data GridRowHomogeneousPropertyInfo instance AttrInfo GridRowHomogeneousPropertyInfo where type AttrAllowedOps GridRowHomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GridRowHomogeneousPropertyInfo = (~) Bool type AttrBaseTypeConstraint GridRowHomogeneousPropertyInfo = GridK type AttrGetType GridRowHomogeneousPropertyInfo = Bool type AttrLabel GridRowHomogeneousPropertyInfo = "Grid::row-homogeneous" attrGet _ = getGridRowHomogeneous attrSet _ = setGridRowHomogeneous attrConstruct _ = constructGridRowHomogeneous -- VVV Prop "row-spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getGridRowSpacing :: (MonadIO m, GridK o) => o -> m Int32 getGridRowSpacing obj = liftIO $ getObjectPropertyCInt obj "row-spacing" setGridRowSpacing :: (MonadIO m, GridK o) => o -> Int32 -> m () setGridRowSpacing obj val = liftIO $ setObjectPropertyCInt obj "row-spacing" val constructGridRowSpacing :: Int32 -> IO ([Char], GValue) constructGridRowSpacing val = constructObjectPropertyCInt "row-spacing" val data GridRowSpacingPropertyInfo instance AttrInfo GridRowSpacingPropertyInfo where type AttrAllowedOps GridRowSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint GridRowSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint GridRowSpacingPropertyInfo = GridK type AttrGetType GridRowSpacingPropertyInfo = Int32 type AttrLabel GridRowSpacingPropertyInfo = "Grid::row-spacing" attrGet _ = getGridRowSpacing attrSet _ = setGridRowSpacing attrConstruct _ = constructGridRowSpacing type instance AttributeList Grid = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-row", GridBaselineRowPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("column-homogeneous", GridColumnHomogeneousPropertyInfo), '("column-spacing", GridColumnSpacingPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("row-homogeneous", GridRowHomogeneousPropertyInfo), '("row-spacing", GridRowSpacingPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList HBox = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList HButtonBox = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("layout-style", ButtonBoxLayoutStylePropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList HPaned = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-position", PanedMaxPositionPropertyInfo), '("min-position", PanedMinPositionPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("position", PanedPositionPropertyInfo), '("position-set", PanedPositionSetPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("wide-handle", PanedWideHandlePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList HSV = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList HScale = '[ '("adjustment", RangeAdjustmentPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("digits", ScaleDigitsPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-value", ScaleDrawValuePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("fill-level", RangeFillLevelPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-origin", ScaleHasOriginPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inverted", RangeInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("lower-stepper-sensitivity", RangeLowerStepperSensitivityPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("restrict-to-fill-level", RangeRestrictToFillLevelPropertyInfo), '("round-digits", RangeRoundDigitsPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-fill-level", RangeShowFillLevelPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("upper-stepper-sensitivity", RangeUpperStepperSensitivityPropertyInfo), '("valign", WidgetValignPropertyInfo), '("value-pos", ScaleValuePosPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList HScrollbar = '[ '("adjustment", RangeAdjustmentPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("fill-level", RangeFillLevelPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inverted", RangeInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("lower-stepper-sensitivity", RangeLowerStepperSensitivityPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("restrict-to-fill-level", RangeRestrictToFillLevelPropertyInfo), '("round-digits", RangeRoundDigitsPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-fill-level", RangeShowFillLevelPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("upper-stepper-sensitivity", RangeUpperStepperSensitivityPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList HSeparator = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "child-detached" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getHandleBoxChildDetached :: (MonadIO m, HandleBoxK o) => o -> m Bool getHandleBoxChildDetached obj = liftIO $ getObjectPropertyBool obj "child-detached" data HandleBoxChildDetachedPropertyInfo instance AttrInfo HandleBoxChildDetachedPropertyInfo where type AttrAllowedOps HandleBoxChildDetachedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint HandleBoxChildDetachedPropertyInfo = (~) () type AttrBaseTypeConstraint HandleBoxChildDetachedPropertyInfo = HandleBoxK type AttrGetType HandleBoxChildDetachedPropertyInfo = Bool type AttrLabel HandleBoxChildDetachedPropertyInfo = "HandleBox::child-detached" attrGet _ = getHandleBoxChildDetached attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "handle-position" -- Type: TInterface "Gtk" "PositionType" -- Flags: [PropertyReadable,PropertyWritable] getHandleBoxHandlePosition :: (MonadIO m, HandleBoxK o) => o -> m PositionType getHandleBoxHandlePosition obj = liftIO $ getObjectPropertyEnum obj "handle-position" setHandleBoxHandlePosition :: (MonadIO m, HandleBoxK o) => o -> PositionType -> m () setHandleBoxHandlePosition obj val = liftIO $ setObjectPropertyEnum obj "handle-position" val constructHandleBoxHandlePosition :: PositionType -> IO ([Char], GValue) constructHandleBoxHandlePosition val = constructObjectPropertyEnum "handle-position" val data HandleBoxHandlePositionPropertyInfo instance AttrInfo HandleBoxHandlePositionPropertyInfo where type AttrAllowedOps HandleBoxHandlePositionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HandleBoxHandlePositionPropertyInfo = (~) PositionType type AttrBaseTypeConstraint HandleBoxHandlePositionPropertyInfo = HandleBoxK type AttrGetType HandleBoxHandlePositionPropertyInfo = PositionType type AttrLabel HandleBoxHandlePositionPropertyInfo = "HandleBox::handle-position" attrGet _ = getHandleBoxHandlePosition attrSet _ = setHandleBoxHandlePosition attrConstruct _ = constructHandleBoxHandlePosition -- VVV Prop "shadow-type" -- Type: TInterface "Gtk" "ShadowType" -- Flags: [PropertyReadable,PropertyWritable] getHandleBoxShadowType :: (MonadIO m, HandleBoxK o) => o -> m ShadowType getHandleBoxShadowType obj = liftIO $ getObjectPropertyEnum obj "shadow-type" setHandleBoxShadowType :: (MonadIO m, HandleBoxK o) => o -> ShadowType -> m () setHandleBoxShadowType obj val = liftIO $ setObjectPropertyEnum obj "shadow-type" val constructHandleBoxShadowType :: ShadowType -> IO ([Char], GValue) constructHandleBoxShadowType val = constructObjectPropertyEnum "shadow-type" val data HandleBoxShadowTypePropertyInfo instance AttrInfo HandleBoxShadowTypePropertyInfo where type AttrAllowedOps HandleBoxShadowTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HandleBoxShadowTypePropertyInfo = (~) ShadowType type AttrBaseTypeConstraint HandleBoxShadowTypePropertyInfo = HandleBoxK type AttrGetType HandleBoxShadowTypePropertyInfo = ShadowType type AttrLabel HandleBoxShadowTypePropertyInfo = "HandleBox::shadow-type" attrGet _ = getHandleBoxShadowType attrSet _ = setHandleBoxShadowType attrConstruct _ = constructHandleBoxShadowType -- VVV Prop "snap-edge" -- Type: TInterface "Gtk" "PositionType" -- Flags: [PropertyReadable,PropertyWritable] getHandleBoxSnapEdge :: (MonadIO m, HandleBoxK o) => o -> m PositionType getHandleBoxSnapEdge obj = liftIO $ getObjectPropertyEnum obj "snap-edge" setHandleBoxSnapEdge :: (MonadIO m, HandleBoxK o) => o -> PositionType -> m () setHandleBoxSnapEdge obj val = liftIO $ setObjectPropertyEnum obj "snap-edge" val constructHandleBoxSnapEdge :: PositionType -> IO ([Char], GValue) constructHandleBoxSnapEdge val = constructObjectPropertyEnum "snap-edge" val data HandleBoxSnapEdgePropertyInfo instance AttrInfo HandleBoxSnapEdgePropertyInfo where type AttrAllowedOps HandleBoxSnapEdgePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HandleBoxSnapEdgePropertyInfo = (~) PositionType type AttrBaseTypeConstraint HandleBoxSnapEdgePropertyInfo = HandleBoxK type AttrGetType HandleBoxSnapEdgePropertyInfo = PositionType type AttrLabel HandleBoxSnapEdgePropertyInfo = "HandleBox::snap-edge" attrGet _ = getHandleBoxSnapEdge attrSet _ = setHandleBoxSnapEdge attrConstruct _ = constructHandleBoxSnapEdge -- VVV Prop "snap-edge-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getHandleBoxSnapEdgeSet :: (MonadIO m, HandleBoxK o) => o -> m Bool getHandleBoxSnapEdgeSet obj = liftIO $ getObjectPropertyBool obj "snap-edge-set" setHandleBoxSnapEdgeSet :: (MonadIO m, HandleBoxK o) => o -> Bool -> m () setHandleBoxSnapEdgeSet obj val = liftIO $ setObjectPropertyBool obj "snap-edge-set" val constructHandleBoxSnapEdgeSet :: Bool -> IO ([Char], GValue) constructHandleBoxSnapEdgeSet val = constructObjectPropertyBool "snap-edge-set" val data HandleBoxSnapEdgeSetPropertyInfo instance AttrInfo HandleBoxSnapEdgeSetPropertyInfo where type AttrAllowedOps HandleBoxSnapEdgeSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HandleBoxSnapEdgeSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint HandleBoxSnapEdgeSetPropertyInfo = HandleBoxK type AttrGetType HandleBoxSnapEdgeSetPropertyInfo = Bool type AttrLabel HandleBoxSnapEdgeSetPropertyInfo = "HandleBox::snap-edge-set" attrGet _ = getHandleBoxSnapEdgeSet attrSet _ = setHandleBoxSnapEdgeSet attrConstruct _ = constructHandleBoxSnapEdgeSet type instance AttributeList HandleBox = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("child-detached", HandleBoxChildDetachedPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("handle-position", HandleBoxHandlePositionPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", HandleBoxShadowTypePropertyInfo), '("snap-edge", HandleBoxSnapEdgePropertyInfo), '("snap-edge-set", HandleBoxSnapEdgeSetPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "custom-title" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getHeaderBarCustomTitle :: (MonadIO m, HeaderBarK o) => o -> m Widget getHeaderBarCustomTitle obj = liftIO $ getObjectPropertyObject obj "custom-title" Widget setHeaderBarCustomTitle :: (MonadIO m, HeaderBarK o, WidgetK a) => o -> a -> m () setHeaderBarCustomTitle obj val = liftIO $ setObjectPropertyObject obj "custom-title" val constructHeaderBarCustomTitle :: (WidgetK a) => a -> IO ([Char], GValue) constructHeaderBarCustomTitle val = constructObjectPropertyObject "custom-title" val data HeaderBarCustomTitlePropertyInfo instance AttrInfo HeaderBarCustomTitlePropertyInfo where type AttrAllowedOps HeaderBarCustomTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HeaderBarCustomTitlePropertyInfo = WidgetK type AttrBaseTypeConstraint HeaderBarCustomTitlePropertyInfo = HeaderBarK type AttrGetType HeaderBarCustomTitlePropertyInfo = Widget type AttrLabel HeaderBarCustomTitlePropertyInfo = "HeaderBar::custom-title" attrGet _ = getHeaderBarCustomTitle attrSet _ = setHeaderBarCustomTitle attrConstruct _ = constructHeaderBarCustomTitle -- VVV Prop "decoration-layout" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getHeaderBarDecorationLayout :: (MonadIO m, HeaderBarK o) => o -> m T.Text getHeaderBarDecorationLayout obj = liftIO $ getObjectPropertyString obj "decoration-layout" setHeaderBarDecorationLayout :: (MonadIO m, HeaderBarK o) => o -> T.Text -> m () setHeaderBarDecorationLayout obj val = liftIO $ setObjectPropertyString obj "decoration-layout" val constructHeaderBarDecorationLayout :: T.Text -> IO ([Char], GValue) constructHeaderBarDecorationLayout val = constructObjectPropertyString "decoration-layout" val data HeaderBarDecorationLayoutPropertyInfo instance AttrInfo HeaderBarDecorationLayoutPropertyInfo where type AttrAllowedOps HeaderBarDecorationLayoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HeaderBarDecorationLayoutPropertyInfo = (~) T.Text type AttrBaseTypeConstraint HeaderBarDecorationLayoutPropertyInfo = HeaderBarK type AttrGetType HeaderBarDecorationLayoutPropertyInfo = T.Text type AttrLabel HeaderBarDecorationLayoutPropertyInfo = "HeaderBar::decoration-layout" attrGet _ = getHeaderBarDecorationLayout attrSet _ = setHeaderBarDecorationLayout attrConstruct _ = constructHeaderBarDecorationLayout -- VVV Prop "decoration-layout-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getHeaderBarDecorationLayoutSet :: (MonadIO m, HeaderBarK o) => o -> m Bool getHeaderBarDecorationLayoutSet obj = liftIO $ getObjectPropertyBool obj "decoration-layout-set" setHeaderBarDecorationLayoutSet :: (MonadIO m, HeaderBarK o) => o -> Bool -> m () setHeaderBarDecorationLayoutSet obj val = liftIO $ setObjectPropertyBool obj "decoration-layout-set" val constructHeaderBarDecorationLayoutSet :: Bool -> IO ([Char], GValue) constructHeaderBarDecorationLayoutSet val = constructObjectPropertyBool "decoration-layout-set" val data HeaderBarDecorationLayoutSetPropertyInfo instance AttrInfo HeaderBarDecorationLayoutSetPropertyInfo where type AttrAllowedOps HeaderBarDecorationLayoutSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HeaderBarDecorationLayoutSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint HeaderBarDecorationLayoutSetPropertyInfo = HeaderBarK type AttrGetType HeaderBarDecorationLayoutSetPropertyInfo = Bool type AttrLabel HeaderBarDecorationLayoutSetPropertyInfo = "HeaderBar::decoration-layout-set" attrGet _ = getHeaderBarDecorationLayoutSet attrSet _ = setHeaderBarDecorationLayoutSet attrConstruct _ = constructHeaderBarDecorationLayoutSet -- VVV Prop "has-subtitle" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getHeaderBarHasSubtitle :: (MonadIO m, HeaderBarK o) => o -> m Bool getHeaderBarHasSubtitle obj = liftIO $ getObjectPropertyBool obj "has-subtitle" setHeaderBarHasSubtitle :: (MonadIO m, HeaderBarK o) => o -> Bool -> m () setHeaderBarHasSubtitle obj val = liftIO $ setObjectPropertyBool obj "has-subtitle" val constructHeaderBarHasSubtitle :: Bool -> IO ([Char], GValue) constructHeaderBarHasSubtitle val = constructObjectPropertyBool "has-subtitle" val data HeaderBarHasSubtitlePropertyInfo instance AttrInfo HeaderBarHasSubtitlePropertyInfo where type AttrAllowedOps HeaderBarHasSubtitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HeaderBarHasSubtitlePropertyInfo = (~) Bool type AttrBaseTypeConstraint HeaderBarHasSubtitlePropertyInfo = HeaderBarK type AttrGetType HeaderBarHasSubtitlePropertyInfo = Bool type AttrLabel HeaderBarHasSubtitlePropertyInfo = "HeaderBar::has-subtitle" attrGet _ = getHeaderBarHasSubtitle attrSet _ = setHeaderBarHasSubtitle attrConstruct _ = constructHeaderBarHasSubtitle -- VVV Prop "show-close-button" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getHeaderBarShowCloseButton :: (MonadIO m, HeaderBarK o) => o -> m Bool getHeaderBarShowCloseButton obj = liftIO $ getObjectPropertyBool obj "show-close-button" setHeaderBarShowCloseButton :: (MonadIO m, HeaderBarK o) => o -> Bool -> m () setHeaderBarShowCloseButton obj val = liftIO $ setObjectPropertyBool obj "show-close-button" val constructHeaderBarShowCloseButton :: Bool -> IO ([Char], GValue) constructHeaderBarShowCloseButton val = constructObjectPropertyBool "show-close-button" val data HeaderBarShowCloseButtonPropertyInfo instance AttrInfo HeaderBarShowCloseButtonPropertyInfo where type AttrAllowedOps HeaderBarShowCloseButtonPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HeaderBarShowCloseButtonPropertyInfo = (~) Bool type AttrBaseTypeConstraint HeaderBarShowCloseButtonPropertyInfo = HeaderBarK type AttrGetType HeaderBarShowCloseButtonPropertyInfo = Bool type AttrLabel HeaderBarShowCloseButtonPropertyInfo = "HeaderBar::show-close-button" attrGet _ = getHeaderBarShowCloseButton attrSet _ = setHeaderBarShowCloseButton attrConstruct _ = constructHeaderBarShowCloseButton -- VVV Prop "spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getHeaderBarSpacing :: (MonadIO m, HeaderBarK o) => o -> m Int32 getHeaderBarSpacing obj = liftIO $ getObjectPropertyCInt obj "spacing" setHeaderBarSpacing :: (MonadIO m, HeaderBarK o) => o -> Int32 -> m () setHeaderBarSpacing obj val = liftIO $ setObjectPropertyCInt obj "spacing" val constructHeaderBarSpacing :: Int32 -> IO ([Char], GValue) constructHeaderBarSpacing val = constructObjectPropertyCInt "spacing" val data HeaderBarSpacingPropertyInfo instance AttrInfo HeaderBarSpacingPropertyInfo where type AttrAllowedOps HeaderBarSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HeaderBarSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint HeaderBarSpacingPropertyInfo = HeaderBarK type AttrGetType HeaderBarSpacingPropertyInfo = Int32 type AttrLabel HeaderBarSpacingPropertyInfo = "HeaderBar::spacing" attrGet _ = getHeaderBarSpacing attrSet _ = setHeaderBarSpacing attrConstruct _ = constructHeaderBarSpacing -- VVV Prop "subtitle" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getHeaderBarSubtitle :: (MonadIO m, HeaderBarK o) => o -> m T.Text getHeaderBarSubtitle obj = liftIO $ getObjectPropertyString obj "subtitle" setHeaderBarSubtitle :: (MonadIO m, HeaderBarK o) => o -> T.Text -> m () setHeaderBarSubtitle obj val = liftIO $ setObjectPropertyString obj "subtitle" val constructHeaderBarSubtitle :: T.Text -> IO ([Char], GValue) constructHeaderBarSubtitle val = constructObjectPropertyString "subtitle" val data HeaderBarSubtitlePropertyInfo instance AttrInfo HeaderBarSubtitlePropertyInfo where type AttrAllowedOps HeaderBarSubtitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HeaderBarSubtitlePropertyInfo = (~) T.Text type AttrBaseTypeConstraint HeaderBarSubtitlePropertyInfo = HeaderBarK type AttrGetType HeaderBarSubtitlePropertyInfo = T.Text type AttrLabel HeaderBarSubtitlePropertyInfo = "HeaderBar::subtitle" attrGet _ = getHeaderBarSubtitle attrSet _ = setHeaderBarSubtitle attrConstruct _ = constructHeaderBarSubtitle -- VVV Prop "title" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getHeaderBarTitle :: (MonadIO m, HeaderBarK o) => o -> m T.Text getHeaderBarTitle obj = liftIO $ getObjectPropertyString obj "title" setHeaderBarTitle :: (MonadIO m, HeaderBarK o) => o -> T.Text -> m () setHeaderBarTitle obj val = liftIO $ setObjectPropertyString obj "title" val constructHeaderBarTitle :: T.Text -> IO ([Char], GValue) constructHeaderBarTitle val = constructObjectPropertyString "title" val data HeaderBarTitlePropertyInfo instance AttrInfo HeaderBarTitlePropertyInfo where type AttrAllowedOps HeaderBarTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint HeaderBarTitlePropertyInfo = (~) T.Text type AttrBaseTypeConstraint HeaderBarTitlePropertyInfo = HeaderBarK type AttrGetType HeaderBarTitlePropertyInfo = T.Text type AttrLabel HeaderBarTitlePropertyInfo = "HeaderBar::title" attrGet _ = getHeaderBarTitle attrSet _ = setHeaderBarTitle attrConstruct _ = constructHeaderBarTitle type instance AttributeList HeaderBar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("custom-title", HeaderBarCustomTitlePropertyInfo), '("decoration-layout", HeaderBarDecorationLayoutPropertyInfo), '("decoration-layout-set", HeaderBarDecorationLayoutSetPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-subtitle", HeaderBarHasSubtitlePropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-close-button", HeaderBarShowCloseButtonPropertyInfo), '("spacing", HeaderBarSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("subtitle", HeaderBarSubtitlePropertyInfo), '("title", HeaderBarTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "input-hints" -- Type: TInterface "Gtk" "InputHints" -- Flags: [PropertyReadable,PropertyWritable] getIMContextInputHints :: (MonadIO m, IMContextK o) => o -> m [InputHints] getIMContextInputHints obj = liftIO $ getObjectPropertyFlags obj "input-hints" setIMContextInputHints :: (MonadIO m, IMContextK o) => o -> [InputHints] -> m () setIMContextInputHints obj val = liftIO $ setObjectPropertyFlags obj "input-hints" val constructIMContextInputHints :: [InputHints] -> IO ([Char], GValue) constructIMContextInputHints val = constructObjectPropertyFlags "input-hints" val data IMContextInputHintsPropertyInfo instance AttrInfo IMContextInputHintsPropertyInfo where type AttrAllowedOps IMContextInputHintsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IMContextInputHintsPropertyInfo = (~) [InputHints] type AttrBaseTypeConstraint IMContextInputHintsPropertyInfo = IMContextK type AttrGetType IMContextInputHintsPropertyInfo = [InputHints] type AttrLabel IMContextInputHintsPropertyInfo = "IMContext::input-hints" attrGet _ = getIMContextInputHints attrSet _ = setIMContextInputHints attrConstruct _ = constructIMContextInputHints -- VVV Prop "input-purpose" -- Type: TInterface "Gtk" "InputPurpose" -- Flags: [PropertyReadable,PropertyWritable] getIMContextInputPurpose :: (MonadIO m, IMContextK o) => o -> m InputPurpose getIMContextInputPurpose obj = liftIO $ getObjectPropertyEnum obj "input-purpose" setIMContextInputPurpose :: (MonadIO m, IMContextK o) => o -> InputPurpose -> m () setIMContextInputPurpose obj val = liftIO $ setObjectPropertyEnum obj "input-purpose" val constructIMContextInputPurpose :: InputPurpose -> IO ([Char], GValue) constructIMContextInputPurpose val = constructObjectPropertyEnum "input-purpose" val data IMContextInputPurposePropertyInfo instance AttrInfo IMContextInputPurposePropertyInfo where type AttrAllowedOps IMContextInputPurposePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IMContextInputPurposePropertyInfo = (~) InputPurpose type AttrBaseTypeConstraint IMContextInputPurposePropertyInfo = IMContextK type AttrGetType IMContextInputPurposePropertyInfo = InputPurpose type AttrLabel IMContextInputPurposePropertyInfo = "IMContext::input-purpose" attrGet _ = getIMContextInputPurpose attrSet _ = setIMContextInputPurpose attrConstruct _ = constructIMContextInputPurpose type instance AttributeList IMContext = '[ '("input-hints", IMContextInputHintsPropertyInfo), '("input-purpose", IMContextInputPurposePropertyInfo)] type instance AttributeList IMContextSimple = '[ '("input-hints", IMContextInputHintsPropertyInfo), '("input-purpose", IMContextInputPurposePropertyInfo)] type instance AttributeList IMMulticontext = '[ '("input-hints", IMContextInputHintsPropertyInfo), '("input-purpose", IMContextInputPurposePropertyInfo)] type instance AttributeList IconFactory = '[ ] type instance AttributeList IconInfo = '[ ] type instance AttributeList IconTheme = '[ ] -- VVV Prop "activate-on-single-click" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getIconViewActivateOnSingleClick :: (MonadIO m, IconViewK o) => o -> m Bool getIconViewActivateOnSingleClick obj = liftIO $ getObjectPropertyBool obj "activate-on-single-click" setIconViewActivateOnSingleClick :: (MonadIO m, IconViewK o) => o -> Bool -> m () setIconViewActivateOnSingleClick obj val = liftIO $ setObjectPropertyBool obj "activate-on-single-click" val constructIconViewActivateOnSingleClick :: Bool -> IO ([Char], GValue) constructIconViewActivateOnSingleClick val = constructObjectPropertyBool "activate-on-single-click" val data IconViewActivateOnSingleClickPropertyInfo instance AttrInfo IconViewActivateOnSingleClickPropertyInfo where type AttrAllowedOps IconViewActivateOnSingleClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewActivateOnSingleClickPropertyInfo = (~) Bool type AttrBaseTypeConstraint IconViewActivateOnSingleClickPropertyInfo = IconViewK type AttrGetType IconViewActivateOnSingleClickPropertyInfo = Bool type AttrLabel IconViewActivateOnSingleClickPropertyInfo = "IconView::activate-on-single-click" attrGet _ = getIconViewActivateOnSingleClick attrSet _ = setIconViewActivateOnSingleClick attrConstruct _ = constructIconViewActivateOnSingleClick -- VVV Prop "cell-area" -- Type: TInterface "Gtk" "CellArea" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getIconViewCellArea :: (MonadIO m, IconViewK o) => o -> m CellArea getIconViewCellArea obj = liftIO $ getObjectPropertyObject obj "cell-area" CellArea constructIconViewCellArea :: (CellAreaK a) => a -> IO ([Char], GValue) constructIconViewCellArea val = constructObjectPropertyObject "cell-area" val data IconViewCellAreaPropertyInfo instance AttrInfo IconViewCellAreaPropertyInfo where type AttrAllowedOps IconViewCellAreaPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewCellAreaPropertyInfo = CellAreaK type AttrBaseTypeConstraint IconViewCellAreaPropertyInfo = IconViewK type AttrGetType IconViewCellAreaPropertyInfo = CellArea type AttrLabel IconViewCellAreaPropertyInfo = "IconView::cell-area" attrGet _ = getIconViewCellArea attrSet _ = undefined attrConstruct _ = constructIconViewCellArea -- VVV Prop "column-spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewColumnSpacing :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewColumnSpacing obj = liftIO $ getObjectPropertyCInt obj "column-spacing" setIconViewColumnSpacing :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewColumnSpacing obj val = liftIO $ setObjectPropertyCInt obj "column-spacing" val constructIconViewColumnSpacing :: Int32 -> IO ([Char], GValue) constructIconViewColumnSpacing val = constructObjectPropertyCInt "column-spacing" val data IconViewColumnSpacingPropertyInfo instance AttrInfo IconViewColumnSpacingPropertyInfo where type AttrAllowedOps IconViewColumnSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewColumnSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewColumnSpacingPropertyInfo = IconViewK type AttrGetType IconViewColumnSpacingPropertyInfo = Int32 type AttrLabel IconViewColumnSpacingPropertyInfo = "IconView::column-spacing" attrGet _ = getIconViewColumnSpacing attrSet _ = setIconViewColumnSpacing attrConstruct _ = constructIconViewColumnSpacing -- VVV Prop "columns" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewColumns :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewColumns obj = liftIO $ getObjectPropertyCInt obj "columns" setIconViewColumns :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewColumns obj val = liftIO $ setObjectPropertyCInt obj "columns" val constructIconViewColumns :: Int32 -> IO ([Char], GValue) constructIconViewColumns val = constructObjectPropertyCInt "columns" val data IconViewColumnsPropertyInfo instance AttrInfo IconViewColumnsPropertyInfo where type AttrAllowedOps IconViewColumnsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewColumnsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewColumnsPropertyInfo = IconViewK type AttrGetType IconViewColumnsPropertyInfo = Int32 type AttrLabel IconViewColumnsPropertyInfo = "IconView::columns" attrGet _ = getIconViewColumns attrSet _ = setIconViewColumns attrConstruct _ = constructIconViewColumns -- VVV Prop "item-orientation" -- Type: TInterface "Gtk" "Orientation" -- Flags: [PropertyReadable,PropertyWritable] getIconViewItemOrientation :: (MonadIO m, IconViewK o) => o -> m Orientation getIconViewItemOrientation obj = liftIO $ getObjectPropertyEnum obj "item-orientation" setIconViewItemOrientation :: (MonadIO m, IconViewK o) => o -> Orientation -> m () setIconViewItemOrientation obj val = liftIO $ setObjectPropertyEnum obj "item-orientation" val constructIconViewItemOrientation :: Orientation -> IO ([Char], GValue) constructIconViewItemOrientation val = constructObjectPropertyEnum "item-orientation" val data IconViewItemOrientationPropertyInfo instance AttrInfo IconViewItemOrientationPropertyInfo where type AttrAllowedOps IconViewItemOrientationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewItemOrientationPropertyInfo = (~) Orientation type AttrBaseTypeConstraint IconViewItemOrientationPropertyInfo = IconViewK type AttrGetType IconViewItemOrientationPropertyInfo = Orientation type AttrLabel IconViewItemOrientationPropertyInfo = "IconView::item-orientation" attrGet _ = getIconViewItemOrientation attrSet _ = setIconViewItemOrientation attrConstruct _ = constructIconViewItemOrientation -- VVV Prop "item-padding" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewItemPadding :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewItemPadding obj = liftIO $ getObjectPropertyCInt obj "item-padding" setIconViewItemPadding :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewItemPadding obj val = liftIO $ setObjectPropertyCInt obj "item-padding" val constructIconViewItemPadding :: Int32 -> IO ([Char], GValue) constructIconViewItemPadding val = constructObjectPropertyCInt "item-padding" val data IconViewItemPaddingPropertyInfo instance AttrInfo IconViewItemPaddingPropertyInfo where type AttrAllowedOps IconViewItemPaddingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewItemPaddingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewItemPaddingPropertyInfo = IconViewK type AttrGetType IconViewItemPaddingPropertyInfo = Int32 type AttrLabel IconViewItemPaddingPropertyInfo = "IconView::item-padding" attrGet _ = getIconViewItemPadding attrSet _ = setIconViewItemPadding attrConstruct _ = constructIconViewItemPadding -- VVV Prop "item-width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewItemWidth :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewItemWidth obj = liftIO $ getObjectPropertyCInt obj "item-width" setIconViewItemWidth :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewItemWidth obj val = liftIO $ setObjectPropertyCInt obj "item-width" val constructIconViewItemWidth :: Int32 -> IO ([Char], GValue) constructIconViewItemWidth val = constructObjectPropertyCInt "item-width" val data IconViewItemWidthPropertyInfo instance AttrInfo IconViewItemWidthPropertyInfo where type AttrAllowedOps IconViewItemWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewItemWidthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewItemWidthPropertyInfo = IconViewK type AttrGetType IconViewItemWidthPropertyInfo = Int32 type AttrLabel IconViewItemWidthPropertyInfo = "IconView::item-width" attrGet _ = getIconViewItemWidth attrSet _ = setIconViewItemWidth attrConstruct _ = constructIconViewItemWidth -- VVV Prop "margin" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewMargin :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewMargin obj = liftIO $ getObjectPropertyCInt obj "margin" setIconViewMargin :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewMargin obj val = liftIO $ setObjectPropertyCInt obj "margin" val constructIconViewMargin :: Int32 -> IO ([Char], GValue) constructIconViewMargin val = constructObjectPropertyCInt "margin" val data IconViewMarginPropertyInfo instance AttrInfo IconViewMarginPropertyInfo where type AttrAllowedOps IconViewMarginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewMarginPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewMarginPropertyInfo = IconViewK type AttrGetType IconViewMarginPropertyInfo = Int32 type AttrLabel IconViewMarginPropertyInfo = "IconView::margin" attrGet _ = getIconViewMargin attrSet _ = setIconViewMargin attrConstruct _ = constructIconViewMargin -- VVV Prop "markup-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewMarkupColumn :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewMarkupColumn obj = liftIO $ getObjectPropertyCInt obj "markup-column" setIconViewMarkupColumn :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewMarkupColumn obj val = liftIO $ setObjectPropertyCInt obj "markup-column" val constructIconViewMarkupColumn :: Int32 -> IO ([Char], GValue) constructIconViewMarkupColumn val = constructObjectPropertyCInt "markup-column" val data IconViewMarkupColumnPropertyInfo instance AttrInfo IconViewMarkupColumnPropertyInfo where type AttrAllowedOps IconViewMarkupColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewMarkupColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewMarkupColumnPropertyInfo = IconViewK type AttrGetType IconViewMarkupColumnPropertyInfo = Int32 type AttrLabel IconViewMarkupColumnPropertyInfo = "IconView::markup-column" attrGet _ = getIconViewMarkupColumn attrSet _ = setIconViewMarkupColumn attrConstruct _ = constructIconViewMarkupColumn -- VVV Prop "model" -- Type: TInterface "Gtk" "TreeModel" -- Flags: [PropertyReadable,PropertyWritable] getIconViewModel :: (MonadIO m, IconViewK o) => o -> m TreeModel getIconViewModel obj = liftIO $ getObjectPropertyObject obj "model" TreeModel setIconViewModel :: (MonadIO m, IconViewK o, TreeModelK a) => o -> a -> m () setIconViewModel obj val = liftIO $ setObjectPropertyObject obj "model" val constructIconViewModel :: (TreeModelK a) => a -> IO ([Char], GValue) constructIconViewModel val = constructObjectPropertyObject "model" val data IconViewModelPropertyInfo instance AttrInfo IconViewModelPropertyInfo where type AttrAllowedOps IconViewModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewModelPropertyInfo = TreeModelK type AttrBaseTypeConstraint IconViewModelPropertyInfo = IconViewK type AttrGetType IconViewModelPropertyInfo = TreeModel type AttrLabel IconViewModelPropertyInfo = "IconView::model" attrGet _ = getIconViewModel attrSet _ = setIconViewModel attrConstruct _ = constructIconViewModel -- VVV Prop "pixbuf-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewPixbufColumn :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewPixbufColumn obj = liftIO $ getObjectPropertyCInt obj "pixbuf-column" setIconViewPixbufColumn :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewPixbufColumn obj val = liftIO $ setObjectPropertyCInt obj "pixbuf-column" val constructIconViewPixbufColumn :: Int32 -> IO ([Char], GValue) constructIconViewPixbufColumn val = constructObjectPropertyCInt "pixbuf-column" val data IconViewPixbufColumnPropertyInfo instance AttrInfo IconViewPixbufColumnPropertyInfo where type AttrAllowedOps IconViewPixbufColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewPixbufColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewPixbufColumnPropertyInfo = IconViewK type AttrGetType IconViewPixbufColumnPropertyInfo = Int32 type AttrLabel IconViewPixbufColumnPropertyInfo = "IconView::pixbuf-column" attrGet _ = getIconViewPixbufColumn attrSet _ = setIconViewPixbufColumn attrConstruct _ = constructIconViewPixbufColumn -- VVV Prop "reorderable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getIconViewReorderable :: (MonadIO m, IconViewK o) => o -> m Bool getIconViewReorderable obj = liftIO $ getObjectPropertyBool obj "reorderable" setIconViewReorderable :: (MonadIO m, IconViewK o) => o -> Bool -> m () setIconViewReorderable obj val = liftIO $ setObjectPropertyBool obj "reorderable" val constructIconViewReorderable :: Bool -> IO ([Char], GValue) constructIconViewReorderable val = constructObjectPropertyBool "reorderable" val data IconViewReorderablePropertyInfo instance AttrInfo IconViewReorderablePropertyInfo where type AttrAllowedOps IconViewReorderablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewReorderablePropertyInfo = (~) Bool type AttrBaseTypeConstraint IconViewReorderablePropertyInfo = IconViewK type AttrGetType IconViewReorderablePropertyInfo = Bool type AttrLabel IconViewReorderablePropertyInfo = "IconView::reorderable" attrGet _ = getIconViewReorderable attrSet _ = setIconViewReorderable attrConstruct _ = constructIconViewReorderable -- VVV Prop "row-spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewRowSpacing :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewRowSpacing obj = liftIO $ getObjectPropertyCInt obj "row-spacing" setIconViewRowSpacing :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewRowSpacing obj val = liftIO $ setObjectPropertyCInt obj "row-spacing" val constructIconViewRowSpacing :: Int32 -> IO ([Char], GValue) constructIconViewRowSpacing val = constructObjectPropertyCInt "row-spacing" val data IconViewRowSpacingPropertyInfo instance AttrInfo IconViewRowSpacingPropertyInfo where type AttrAllowedOps IconViewRowSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewRowSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewRowSpacingPropertyInfo = IconViewK type AttrGetType IconViewRowSpacingPropertyInfo = Int32 type AttrLabel IconViewRowSpacingPropertyInfo = "IconView::row-spacing" attrGet _ = getIconViewRowSpacing attrSet _ = setIconViewRowSpacing attrConstruct _ = constructIconViewRowSpacing -- VVV Prop "selection-mode" -- Type: TInterface "Gtk" "SelectionMode" -- Flags: [PropertyReadable,PropertyWritable] getIconViewSelectionMode :: (MonadIO m, IconViewK o) => o -> m SelectionMode getIconViewSelectionMode obj = liftIO $ getObjectPropertyEnum obj "selection-mode" setIconViewSelectionMode :: (MonadIO m, IconViewK o) => o -> SelectionMode -> m () setIconViewSelectionMode obj val = liftIO $ setObjectPropertyEnum obj "selection-mode" val constructIconViewSelectionMode :: SelectionMode -> IO ([Char], GValue) constructIconViewSelectionMode val = constructObjectPropertyEnum "selection-mode" val data IconViewSelectionModePropertyInfo instance AttrInfo IconViewSelectionModePropertyInfo where type AttrAllowedOps IconViewSelectionModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewSelectionModePropertyInfo = (~) SelectionMode type AttrBaseTypeConstraint IconViewSelectionModePropertyInfo = IconViewK type AttrGetType IconViewSelectionModePropertyInfo = SelectionMode type AttrLabel IconViewSelectionModePropertyInfo = "IconView::selection-mode" attrGet _ = getIconViewSelectionMode attrSet _ = setIconViewSelectionMode attrConstruct _ = constructIconViewSelectionMode -- VVV Prop "spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewSpacing :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewSpacing obj = liftIO $ getObjectPropertyCInt obj "spacing" setIconViewSpacing :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewSpacing obj val = liftIO $ setObjectPropertyCInt obj "spacing" val constructIconViewSpacing :: Int32 -> IO ([Char], GValue) constructIconViewSpacing val = constructObjectPropertyCInt "spacing" val data IconViewSpacingPropertyInfo instance AttrInfo IconViewSpacingPropertyInfo where type AttrAllowedOps IconViewSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewSpacingPropertyInfo = IconViewK type AttrGetType IconViewSpacingPropertyInfo = Int32 type AttrLabel IconViewSpacingPropertyInfo = "IconView::spacing" attrGet _ = getIconViewSpacing attrSet _ = setIconViewSpacing attrConstruct _ = constructIconViewSpacing -- VVV Prop "text-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewTextColumn :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewTextColumn obj = liftIO $ getObjectPropertyCInt obj "text-column" setIconViewTextColumn :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewTextColumn obj val = liftIO $ setObjectPropertyCInt obj "text-column" val constructIconViewTextColumn :: Int32 -> IO ([Char], GValue) constructIconViewTextColumn val = constructObjectPropertyCInt "text-column" val data IconViewTextColumnPropertyInfo instance AttrInfo IconViewTextColumnPropertyInfo where type AttrAllowedOps IconViewTextColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewTextColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewTextColumnPropertyInfo = IconViewK type AttrGetType IconViewTextColumnPropertyInfo = Int32 type AttrLabel IconViewTextColumnPropertyInfo = "IconView::text-column" attrGet _ = getIconViewTextColumn attrSet _ = setIconViewTextColumn attrConstruct _ = constructIconViewTextColumn -- VVV Prop "tooltip-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getIconViewTooltipColumn :: (MonadIO m, IconViewK o) => o -> m Int32 getIconViewTooltipColumn obj = liftIO $ getObjectPropertyCInt obj "tooltip-column" setIconViewTooltipColumn :: (MonadIO m, IconViewK o) => o -> Int32 -> m () setIconViewTooltipColumn obj val = liftIO $ setObjectPropertyCInt obj "tooltip-column" val constructIconViewTooltipColumn :: Int32 -> IO ([Char], GValue) constructIconViewTooltipColumn val = constructObjectPropertyCInt "tooltip-column" val data IconViewTooltipColumnPropertyInfo instance AttrInfo IconViewTooltipColumnPropertyInfo where type AttrAllowedOps IconViewTooltipColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint IconViewTooltipColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint IconViewTooltipColumnPropertyInfo = IconViewK type AttrGetType IconViewTooltipColumnPropertyInfo = Int32 type AttrLabel IconViewTooltipColumnPropertyInfo = "IconView::tooltip-column" attrGet _ = getIconViewTooltipColumn attrSet _ = setIconViewTooltipColumn attrConstruct _ = constructIconViewTooltipColumn type instance AttributeList IconView = '[ '("activate-on-single-click", IconViewActivateOnSingleClickPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("cell-area", IconViewCellAreaPropertyInfo), '("child", ContainerChildPropertyInfo), '("column-spacing", IconViewColumnSpacingPropertyInfo), '("columns", IconViewColumnsPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("hadjustment", ScrollableHadjustmentPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hscroll-policy", ScrollableHscrollPolicyPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("item-orientation", IconViewItemOrientationPropertyInfo), '("item-padding", IconViewItemPaddingPropertyInfo), '("item-width", IconViewItemWidthPropertyInfo), '("margin", IconViewMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("markup-column", IconViewMarkupColumnPropertyInfo), '("model", IconViewModelPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("pixbuf-column", IconViewPixbufColumnPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("reorderable", IconViewReorderablePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("row-spacing", IconViewRowSpacingPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("selection-mode", IconViewSelectionModePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", IconViewSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("text-column", IconViewTextColumnPropertyInfo), '("tooltip-column", IconViewTooltipColumnPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("vadjustment", ScrollableVadjustmentPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("vscroll-policy", ScrollableVscrollPolicyPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList IconViewAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "file" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getImageFile :: (MonadIO m, ImageK o) => o -> m T.Text getImageFile obj = liftIO $ getObjectPropertyString obj "file" setImageFile :: (MonadIO m, ImageK o) => o -> T.Text -> m () setImageFile obj val = liftIO $ setObjectPropertyString obj "file" val constructImageFile :: T.Text -> IO ([Char], GValue) constructImageFile val = constructObjectPropertyString "file" val data ImageFilePropertyInfo instance AttrInfo ImageFilePropertyInfo where type AttrAllowedOps ImageFilePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageFilePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ImageFilePropertyInfo = ImageK type AttrGetType ImageFilePropertyInfo = T.Text type AttrLabel ImageFilePropertyInfo = "Image::file" attrGet _ = getImageFile attrSet _ = setImageFile attrConstruct _ = constructImageFile -- VVV Prop "gicon" -- Type: TInterface "Gio" "Icon" -- Flags: [PropertyReadable,PropertyWritable] getImageGicon :: (MonadIO m, ImageK o) => o -> m Gio.Icon getImageGicon obj = liftIO $ getObjectPropertyObject obj "gicon" Gio.Icon setImageGicon :: (MonadIO m, ImageK o, Gio.IconK a) => o -> a -> m () setImageGicon obj val = liftIO $ setObjectPropertyObject obj "gicon" val constructImageGicon :: (Gio.IconK a) => a -> IO ([Char], GValue) constructImageGicon val = constructObjectPropertyObject "gicon" val data ImageGiconPropertyInfo instance AttrInfo ImageGiconPropertyInfo where type AttrAllowedOps ImageGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageGiconPropertyInfo = Gio.IconK type AttrBaseTypeConstraint ImageGiconPropertyInfo = ImageK type AttrGetType ImageGiconPropertyInfo = Gio.Icon type AttrLabel ImageGiconPropertyInfo = "Image::gicon" attrGet _ = getImageGicon attrSet _ = setImageGicon attrConstruct _ = constructImageGicon -- VVV Prop "icon-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getImageIconName :: (MonadIO m, ImageK o) => o -> m T.Text getImageIconName obj = liftIO $ getObjectPropertyString obj "icon-name" setImageIconName :: (MonadIO m, ImageK o) => o -> T.Text -> m () setImageIconName obj val = liftIO $ setObjectPropertyString obj "icon-name" val constructImageIconName :: T.Text -> IO ([Char], GValue) constructImageIconName val = constructObjectPropertyString "icon-name" val data ImageIconNamePropertyInfo instance AttrInfo ImageIconNamePropertyInfo where type AttrAllowedOps ImageIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ImageIconNamePropertyInfo = ImageK type AttrGetType ImageIconNamePropertyInfo = T.Text type AttrLabel ImageIconNamePropertyInfo = "Image::icon-name" attrGet _ = getImageIconName attrSet _ = setImageIconName attrConstruct _ = constructImageIconName -- VVV Prop "icon-set" -- Type: TInterface "Gtk" "IconSet" -- Flags: [PropertyReadable,PropertyWritable] getImageIconSet :: (MonadIO m, ImageK o) => o -> m IconSet getImageIconSet obj = liftIO $ getObjectPropertyBoxed obj "icon-set" IconSet setImageIconSet :: (MonadIO m, ImageK o) => o -> IconSet -> m () setImageIconSet obj val = liftIO $ setObjectPropertyBoxed obj "icon-set" val constructImageIconSet :: IconSet -> IO ([Char], GValue) constructImageIconSet val = constructObjectPropertyBoxed "icon-set" val data ImageIconSetPropertyInfo instance AttrInfo ImageIconSetPropertyInfo where type AttrAllowedOps ImageIconSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageIconSetPropertyInfo = (~) IconSet type AttrBaseTypeConstraint ImageIconSetPropertyInfo = ImageK type AttrGetType ImageIconSetPropertyInfo = IconSet type AttrLabel ImageIconSetPropertyInfo = "Image::icon-set" attrGet _ = getImageIconSet attrSet _ = setImageIconSet attrConstruct _ = constructImageIconSet -- VVV Prop "icon-size" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getImageIconSize :: (MonadIO m, ImageK o) => o -> m Int32 getImageIconSize obj = liftIO $ getObjectPropertyCInt obj "icon-size" setImageIconSize :: (MonadIO m, ImageK o) => o -> Int32 -> m () setImageIconSize obj val = liftIO $ setObjectPropertyCInt obj "icon-size" val constructImageIconSize :: Int32 -> IO ([Char], GValue) constructImageIconSize val = constructObjectPropertyCInt "icon-size" val data ImageIconSizePropertyInfo instance AttrInfo ImageIconSizePropertyInfo where type AttrAllowedOps ImageIconSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageIconSizePropertyInfo = (~) Int32 type AttrBaseTypeConstraint ImageIconSizePropertyInfo = ImageK type AttrGetType ImageIconSizePropertyInfo = Int32 type AttrLabel ImageIconSizePropertyInfo = "Image::icon-size" attrGet _ = getImageIconSize attrSet _ = setImageIconSize attrConstruct _ = constructImageIconSize -- VVV Prop "pixbuf" -- Type: TInterface "GdkPixbuf" "Pixbuf" -- Flags: [PropertyReadable,PropertyWritable] getImagePixbuf :: (MonadIO m, ImageK o) => o -> m GdkPixbuf.Pixbuf getImagePixbuf obj = liftIO $ getObjectPropertyObject obj "pixbuf" GdkPixbuf.Pixbuf setImagePixbuf :: (MonadIO m, ImageK o, GdkPixbuf.PixbufK a) => o -> a -> m () setImagePixbuf obj val = liftIO $ setObjectPropertyObject obj "pixbuf" val constructImagePixbuf :: (GdkPixbuf.PixbufK a) => a -> IO ([Char], GValue) constructImagePixbuf val = constructObjectPropertyObject "pixbuf" val data ImagePixbufPropertyInfo instance AttrInfo ImagePixbufPropertyInfo where type AttrAllowedOps ImagePixbufPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImagePixbufPropertyInfo = GdkPixbuf.PixbufK type AttrBaseTypeConstraint ImagePixbufPropertyInfo = ImageK type AttrGetType ImagePixbufPropertyInfo = GdkPixbuf.Pixbuf type AttrLabel ImagePixbufPropertyInfo = "Image::pixbuf" attrGet _ = getImagePixbuf attrSet _ = setImagePixbuf attrConstruct _ = constructImagePixbuf -- VVV Prop "pixbuf-animation" -- Type: TInterface "GdkPixbuf" "PixbufAnimation" -- Flags: [PropertyReadable,PropertyWritable] getImagePixbufAnimation :: (MonadIO m, ImageK o) => o -> m GdkPixbuf.PixbufAnimation getImagePixbufAnimation obj = liftIO $ getObjectPropertyObject obj "pixbuf-animation" GdkPixbuf.PixbufAnimation setImagePixbufAnimation :: (MonadIO m, ImageK o, GdkPixbuf.PixbufAnimationK a) => o -> a -> m () setImagePixbufAnimation obj val = liftIO $ setObjectPropertyObject obj "pixbuf-animation" val constructImagePixbufAnimation :: (GdkPixbuf.PixbufAnimationK a) => a -> IO ([Char], GValue) constructImagePixbufAnimation val = constructObjectPropertyObject "pixbuf-animation" val data ImagePixbufAnimationPropertyInfo instance AttrInfo ImagePixbufAnimationPropertyInfo where type AttrAllowedOps ImagePixbufAnimationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImagePixbufAnimationPropertyInfo = GdkPixbuf.PixbufAnimationK type AttrBaseTypeConstraint ImagePixbufAnimationPropertyInfo = ImageK type AttrGetType ImagePixbufAnimationPropertyInfo = GdkPixbuf.PixbufAnimation type AttrLabel ImagePixbufAnimationPropertyInfo = "Image::pixbuf-animation" attrGet _ = getImagePixbufAnimation attrSet _ = setImagePixbufAnimation attrConstruct _ = constructImagePixbufAnimation -- VVV Prop "pixel-size" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getImagePixelSize :: (MonadIO m, ImageK o) => o -> m Int32 getImagePixelSize obj = liftIO $ getObjectPropertyCInt obj "pixel-size" setImagePixelSize :: (MonadIO m, ImageK o) => o -> Int32 -> m () setImagePixelSize obj val = liftIO $ setObjectPropertyCInt obj "pixel-size" val constructImagePixelSize :: Int32 -> IO ([Char], GValue) constructImagePixelSize val = constructObjectPropertyCInt "pixel-size" val data ImagePixelSizePropertyInfo instance AttrInfo ImagePixelSizePropertyInfo where type AttrAllowedOps ImagePixelSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImagePixelSizePropertyInfo = (~) Int32 type AttrBaseTypeConstraint ImagePixelSizePropertyInfo = ImageK type AttrGetType ImagePixelSizePropertyInfo = Int32 type AttrLabel ImagePixelSizePropertyInfo = "Image::pixel-size" attrGet _ = getImagePixelSize attrSet _ = setImagePixelSize attrConstruct _ = constructImagePixelSize -- VVV Prop "resource" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getImageResource :: (MonadIO m, ImageK o) => o -> m T.Text getImageResource obj = liftIO $ getObjectPropertyString obj "resource" setImageResource :: (MonadIO m, ImageK o) => o -> T.Text -> m () setImageResource obj val = liftIO $ setObjectPropertyString obj "resource" val constructImageResource :: T.Text -> IO ([Char], GValue) constructImageResource val = constructObjectPropertyString "resource" val data ImageResourcePropertyInfo instance AttrInfo ImageResourcePropertyInfo where type AttrAllowedOps ImageResourcePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageResourcePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ImageResourcePropertyInfo = ImageK type AttrGetType ImageResourcePropertyInfo = T.Text type AttrLabel ImageResourcePropertyInfo = "Image::resource" attrGet _ = getImageResource attrSet _ = setImageResource attrConstruct _ = constructImageResource -- VVV Prop "stock" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getImageStock :: (MonadIO m, ImageK o) => o -> m T.Text getImageStock obj = liftIO $ getObjectPropertyString obj "stock" setImageStock :: (MonadIO m, ImageK o) => o -> T.Text -> m () setImageStock obj val = liftIO $ setObjectPropertyString obj "stock" val constructImageStock :: T.Text -> IO ([Char], GValue) constructImageStock val = constructObjectPropertyString "stock" val data ImageStockPropertyInfo instance AttrInfo ImageStockPropertyInfo where type AttrAllowedOps ImageStockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageStockPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ImageStockPropertyInfo = ImageK type AttrGetType ImageStockPropertyInfo = T.Text type AttrLabel ImageStockPropertyInfo = "Image::stock" attrGet _ = getImageStock attrSet _ = setImageStock attrConstruct _ = constructImageStock -- VVV Prop "storage-type" -- Type: TInterface "Gtk" "ImageType" -- Flags: [PropertyReadable] getImageStorageType :: (MonadIO m, ImageK o) => o -> m ImageType getImageStorageType obj = liftIO $ getObjectPropertyEnum obj "storage-type" data ImageStorageTypePropertyInfo instance AttrInfo ImageStorageTypePropertyInfo where type AttrAllowedOps ImageStorageTypePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ImageStorageTypePropertyInfo = (~) () type AttrBaseTypeConstraint ImageStorageTypePropertyInfo = ImageK type AttrGetType ImageStorageTypePropertyInfo = ImageType type AttrLabel ImageStorageTypePropertyInfo = "Image::storage-type" attrGet _ = getImageStorageType attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "surface" -- Type: TInterface "cairo" "Surface" -- Flags: [PropertyReadable,PropertyWritable] getImageSurface :: (MonadIO m, ImageK o) => o -> m Cairo.Surface getImageSurface obj = liftIO $ getObjectPropertyBoxed obj "surface" Cairo.Surface setImageSurface :: (MonadIO m, ImageK o) => o -> Cairo.Surface -> m () setImageSurface obj val = liftIO $ setObjectPropertyBoxed obj "surface" val constructImageSurface :: Cairo.Surface -> IO ([Char], GValue) constructImageSurface val = constructObjectPropertyBoxed "surface" val data ImageSurfacePropertyInfo instance AttrInfo ImageSurfacePropertyInfo where type AttrAllowedOps ImageSurfacePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageSurfacePropertyInfo = (~) Cairo.Surface type AttrBaseTypeConstraint ImageSurfacePropertyInfo = ImageK type AttrGetType ImageSurfacePropertyInfo = Cairo.Surface type AttrLabel ImageSurfacePropertyInfo = "Image::surface" attrGet _ = getImageSurface attrSet _ = setImageSurface attrConstruct _ = constructImageSurface -- VVV Prop "use-fallback" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getImageUseFallback :: (MonadIO m, ImageK o) => o -> m Bool getImageUseFallback obj = liftIO $ getObjectPropertyBool obj "use-fallback" setImageUseFallback :: (MonadIO m, ImageK o) => o -> Bool -> m () setImageUseFallback obj val = liftIO $ setObjectPropertyBool obj "use-fallback" val constructImageUseFallback :: Bool -> IO ([Char], GValue) constructImageUseFallback val = constructObjectPropertyBool "use-fallback" val data ImageUseFallbackPropertyInfo instance AttrInfo ImageUseFallbackPropertyInfo where type AttrAllowedOps ImageUseFallbackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageUseFallbackPropertyInfo = (~) Bool type AttrBaseTypeConstraint ImageUseFallbackPropertyInfo = ImageK type AttrGetType ImageUseFallbackPropertyInfo = Bool type AttrLabel ImageUseFallbackPropertyInfo = "Image::use-fallback" attrGet _ = getImageUseFallback attrSet _ = setImageUseFallback attrConstruct _ = constructImageUseFallback type instance AttributeList Image = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("file", ImageFilePropertyInfo), '("gicon", ImageGiconPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("icon-name", ImageIconNamePropertyInfo), '("icon-set", ImageIconSetPropertyInfo), '("icon-size", ImageIconSizePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("pixbuf", ImagePixbufPropertyInfo), '("pixbuf-animation", ImagePixbufAnimationPropertyInfo), '("pixel-size", ImagePixelSizePropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resource", ImageResourcePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("stock", ImageStockPropertyInfo), '("storage-type", ImageStorageTypePropertyInfo), '("style", WidgetStylePropertyInfo), '("surface", ImageSurfacePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-fallback", ImageUseFallbackPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", MiscXalignPropertyInfo), '("xpad", MiscXpadPropertyInfo), '("yalign", MiscYalignPropertyInfo), '("ypad", MiscYpadPropertyInfo)] type instance AttributeList ImageAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList ImageCellAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("renderer", RendererCellAccessibleRendererPropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "accel-group" -- Type: TInterface "Gtk" "AccelGroup" -- Flags: [PropertyWritable] setImageMenuItemAccelGroup :: (MonadIO m, ImageMenuItemK o, AccelGroupK a) => o -> a -> m () setImageMenuItemAccelGroup obj val = liftIO $ setObjectPropertyObject obj "accel-group" val constructImageMenuItemAccelGroup :: (AccelGroupK a) => a -> IO ([Char], GValue) constructImageMenuItemAccelGroup val = constructObjectPropertyObject "accel-group" val data ImageMenuItemAccelGroupPropertyInfo instance AttrInfo ImageMenuItemAccelGroupPropertyInfo where type AttrAllowedOps ImageMenuItemAccelGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint ImageMenuItemAccelGroupPropertyInfo = AccelGroupK type AttrBaseTypeConstraint ImageMenuItemAccelGroupPropertyInfo = ImageMenuItemK type AttrGetType ImageMenuItemAccelGroupPropertyInfo = () type AttrLabel ImageMenuItemAccelGroupPropertyInfo = "ImageMenuItem::accel-group" attrGet _ = undefined attrSet _ = setImageMenuItemAccelGroup attrConstruct _ = constructImageMenuItemAccelGroup -- VVV Prop "always-show-image" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getImageMenuItemAlwaysShowImage :: (MonadIO m, ImageMenuItemK o) => o -> m Bool getImageMenuItemAlwaysShowImage obj = liftIO $ getObjectPropertyBool obj "always-show-image" setImageMenuItemAlwaysShowImage :: (MonadIO m, ImageMenuItemK o) => o -> Bool -> m () setImageMenuItemAlwaysShowImage obj val = liftIO $ setObjectPropertyBool obj "always-show-image" val constructImageMenuItemAlwaysShowImage :: Bool -> IO ([Char], GValue) constructImageMenuItemAlwaysShowImage val = constructObjectPropertyBool "always-show-image" val data ImageMenuItemAlwaysShowImagePropertyInfo instance AttrInfo ImageMenuItemAlwaysShowImagePropertyInfo where type AttrAllowedOps ImageMenuItemAlwaysShowImagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageMenuItemAlwaysShowImagePropertyInfo = (~) Bool type AttrBaseTypeConstraint ImageMenuItemAlwaysShowImagePropertyInfo = ImageMenuItemK type AttrGetType ImageMenuItemAlwaysShowImagePropertyInfo = Bool type AttrLabel ImageMenuItemAlwaysShowImagePropertyInfo = "ImageMenuItem::always-show-image" attrGet _ = getImageMenuItemAlwaysShowImage attrSet _ = setImageMenuItemAlwaysShowImage attrConstruct _ = constructImageMenuItemAlwaysShowImage -- VVV Prop "image" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getImageMenuItemImage :: (MonadIO m, ImageMenuItemK o) => o -> m Widget getImageMenuItemImage obj = liftIO $ getObjectPropertyObject obj "image" Widget setImageMenuItemImage :: (MonadIO m, ImageMenuItemK o, WidgetK a) => o -> a -> m () setImageMenuItemImage obj val = liftIO $ setObjectPropertyObject obj "image" val constructImageMenuItemImage :: (WidgetK a) => a -> IO ([Char], GValue) constructImageMenuItemImage val = constructObjectPropertyObject "image" val data ImageMenuItemImagePropertyInfo instance AttrInfo ImageMenuItemImagePropertyInfo where type AttrAllowedOps ImageMenuItemImagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageMenuItemImagePropertyInfo = WidgetK type AttrBaseTypeConstraint ImageMenuItemImagePropertyInfo = ImageMenuItemK type AttrGetType ImageMenuItemImagePropertyInfo = Widget type AttrLabel ImageMenuItemImagePropertyInfo = "ImageMenuItem::image" attrGet _ = getImageMenuItemImage attrSet _ = setImageMenuItemImage attrConstruct _ = constructImageMenuItemImage -- VVV Prop "use-stock" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getImageMenuItemUseStock :: (MonadIO m, ImageMenuItemK o) => o -> m Bool getImageMenuItemUseStock obj = liftIO $ getObjectPropertyBool obj "use-stock" setImageMenuItemUseStock :: (MonadIO m, ImageMenuItemK o) => o -> Bool -> m () setImageMenuItemUseStock obj val = liftIO $ setObjectPropertyBool obj "use-stock" val constructImageMenuItemUseStock :: Bool -> IO ([Char], GValue) constructImageMenuItemUseStock val = constructObjectPropertyBool "use-stock" val data ImageMenuItemUseStockPropertyInfo instance AttrInfo ImageMenuItemUseStockPropertyInfo where type AttrAllowedOps ImageMenuItemUseStockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ImageMenuItemUseStockPropertyInfo = (~) Bool type AttrBaseTypeConstraint ImageMenuItemUseStockPropertyInfo = ImageMenuItemK type AttrGetType ImageMenuItemUseStockPropertyInfo = Bool type AttrLabel ImageMenuItemUseStockPropertyInfo = "ImageMenuItem::use-stock" attrGet _ = getImageMenuItemUseStock attrSet _ = setImageMenuItemUseStock attrConstruct _ = constructImageMenuItemUseStock type instance AttributeList ImageMenuItem = '[ '("accel-group", ImageMenuItemAccelGroupPropertyInfo), '("accel-path", MenuItemAccelPathPropertyInfo), '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("always-show-image", ImageMenuItemAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("image", ImageMenuItemImagePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", MenuItemLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("right-justified", MenuItemRightJustifiedPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("submenu", MenuItemSubmenuPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ImageMenuItemUseStockPropertyInfo), '("use-underline", MenuItemUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "message-type" -- Type: TInterface "Gtk" "MessageType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getInfoBarMessageType :: (MonadIO m, InfoBarK o) => o -> m MessageType getInfoBarMessageType obj = liftIO $ getObjectPropertyEnum obj "message-type" setInfoBarMessageType :: (MonadIO m, InfoBarK o) => o -> MessageType -> m () setInfoBarMessageType obj val = liftIO $ setObjectPropertyEnum obj "message-type" val constructInfoBarMessageType :: MessageType -> IO ([Char], GValue) constructInfoBarMessageType val = constructObjectPropertyEnum "message-type" val data InfoBarMessageTypePropertyInfo instance AttrInfo InfoBarMessageTypePropertyInfo where type AttrAllowedOps InfoBarMessageTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InfoBarMessageTypePropertyInfo = (~) MessageType type AttrBaseTypeConstraint InfoBarMessageTypePropertyInfo = InfoBarK type AttrGetType InfoBarMessageTypePropertyInfo = MessageType type AttrLabel InfoBarMessageTypePropertyInfo = "InfoBar::message-type" attrGet _ = getInfoBarMessageType attrSet _ = setInfoBarMessageType attrConstruct _ = constructInfoBarMessageType -- VVV Prop "show-close-button" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getInfoBarShowCloseButton :: (MonadIO m, InfoBarK o) => o -> m Bool getInfoBarShowCloseButton obj = liftIO $ getObjectPropertyBool obj "show-close-button" setInfoBarShowCloseButton :: (MonadIO m, InfoBarK o) => o -> Bool -> m () setInfoBarShowCloseButton obj val = liftIO $ setObjectPropertyBool obj "show-close-button" val constructInfoBarShowCloseButton :: Bool -> IO ([Char], GValue) constructInfoBarShowCloseButton val = constructObjectPropertyBool "show-close-button" val data InfoBarShowCloseButtonPropertyInfo instance AttrInfo InfoBarShowCloseButtonPropertyInfo where type AttrAllowedOps InfoBarShowCloseButtonPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InfoBarShowCloseButtonPropertyInfo = (~) Bool type AttrBaseTypeConstraint InfoBarShowCloseButtonPropertyInfo = InfoBarK type AttrGetType InfoBarShowCloseButtonPropertyInfo = Bool type AttrLabel InfoBarShowCloseButtonPropertyInfo = "InfoBar::show-close-button" attrGet _ = getInfoBarShowCloseButton attrSet _ = setInfoBarShowCloseButton attrConstruct _ = constructInfoBarShowCloseButton type instance AttributeList InfoBar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("message-type", InfoBarMessageTypePropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-close-button", InfoBarShowCloseButtonPropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "screen" -- Type: TInterface "Gdk" "Screen" -- Flags: [PropertyReadable,PropertyWritable] getInvisibleScreen :: (MonadIO m, InvisibleK o) => o -> m Gdk.Screen getInvisibleScreen obj = liftIO $ getObjectPropertyObject obj "screen" Gdk.Screen setInvisibleScreen :: (MonadIO m, InvisibleK o, Gdk.ScreenK a) => o -> a -> m () setInvisibleScreen obj val = liftIO $ setObjectPropertyObject obj "screen" val constructInvisibleScreen :: (Gdk.ScreenK a) => a -> IO ([Char], GValue) constructInvisibleScreen val = constructObjectPropertyObject "screen" val data InvisibleScreenPropertyInfo instance AttrInfo InvisibleScreenPropertyInfo where type AttrAllowedOps InvisibleScreenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InvisibleScreenPropertyInfo = Gdk.ScreenK type AttrBaseTypeConstraint InvisibleScreenPropertyInfo = InvisibleK type AttrGetType InvisibleScreenPropertyInfo = Gdk.Screen type AttrLabel InvisibleScreenPropertyInfo = "Invisible::screen" attrGet _ = getInvisibleScreen attrSet _ = setInvisibleScreen attrConstruct _ = constructInvisibleScreen type instance AttributeList Invisible = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", InvisibleScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] --- XXX Duplicated object with different types: --- Name {namespace = "Gtk", name = "Label"} -> Property {propName = "xalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gtk", name = "Misc"} -> Property {propName = "xalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Just (DeprecationInfo {deprecatedSinceVersion = Just "3.14", deprecationMessage = Just "Use gtk_widget_set_halign() instead. If you are using\n #GtkLabel, use #GtkLabel:xalign instead."})} --- XXX Duplicated object with different types: --- Name {namespace = "Gtk", name = "Label"} -> Property {propName = "yalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gtk", name = "Misc"} -> Property {propName = "yalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Just (DeprecationInfo {deprecatedSinceVersion = Just "3.14", deprecationMessage = Just "Use gtk_widget_set_valign() instead. If you are using\n #GtkLabel, use #GtkLabel:yalign instead."})} -- VVV Prop "angle" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getLabelAngle :: (MonadIO m, LabelK o) => o -> m Double getLabelAngle obj = liftIO $ getObjectPropertyDouble obj "angle" setLabelAngle :: (MonadIO m, LabelK o) => o -> Double -> m () setLabelAngle obj val = liftIO $ setObjectPropertyDouble obj "angle" val constructLabelAngle :: Double -> IO ([Char], GValue) constructLabelAngle val = constructObjectPropertyDouble "angle" val data LabelAnglePropertyInfo instance AttrInfo LabelAnglePropertyInfo where type AttrAllowedOps LabelAnglePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelAnglePropertyInfo = (~) Double type AttrBaseTypeConstraint LabelAnglePropertyInfo = LabelK type AttrGetType LabelAnglePropertyInfo = Double type AttrLabel LabelAnglePropertyInfo = "Label::angle" attrGet _ = getLabelAngle attrSet _ = setLabelAngle attrConstruct _ = constructLabelAngle -- VVV Prop "attributes" -- Type: TInterface "Pango" "AttrList" -- Flags: [PropertyReadable,PropertyWritable] getLabelAttributes :: (MonadIO m, LabelK o) => o -> m Pango.AttrList getLabelAttributes obj = liftIO $ getObjectPropertyBoxed obj "attributes" Pango.AttrList setLabelAttributes :: (MonadIO m, LabelK o) => o -> Pango.AttrList -> m () setLabelAttributes obj val = liftIO $ setObjectPropertyBoxed obj "attributes" val constructLabelAttributes :: Pango.AttrList -> IO ([Char], GValue) constructLabelAttributes val = constructObjectPropertyBoxed "attributes" val data LabelAttributesPropertyInfo instance AttrInfo LabelAttributesPropertyInfo where type AttrAllowedOps LabelAttributesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelAttributesPropertyInfo = (~) Pango.AttrList type AttrBaseTypeConstraint LabelAttributesPropertyInfo = LabelK type AttrGetType LabelAttributesPropertyInfo = Pango.AttrList type AttrLabel LabelAttributesPropertyInfo = "Label::attributes" attrGet _ = getLabelAttributes attrSet _ = setLabelAttributes attrConstruct _ = constructLabelAttributes -- VVV Prop "cursor-position" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getLabelCursorPosition :: (MonadIO m, LabelK o) => o -> m Int32 getLabelCursorPosition obj = liftIO $ getObjectPropertyCInt obj "cursor-position" data LabelCursorPositionPropertyInfo instance AttrInfo LabelCursorPositionPropertyInfo where type AttrAllowedOps LabelCursorPositionPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint LabelCursorPositionPropertyInfo = (~) () type AttrBaseTypeConstraint LabelCursorPositionPropertyInfo = LabelK type AttrGetType LabelCursorPositionPropertyInfo = Int32 type AttrLabel LabelCursorPositionPropertyInfo = "Label::cursor-position" attrGet _ = getLabelCursorPosition attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "ellipsize" -- Type: TInterface "Pango" "EllipsizeMode" -- Flags: [PropertyReadable,PropertyWritable] getLabelEllipsize :: (MonadIO m, LabelK o) => o -> m Pango.EllipsizeMode getLabelEllipsize obj = liftIO $ getObjectPropertyEnum obj "ellipsize" setLabelEllipsize :: (MonadIO m, LabelK o) => o -> Pango.EllipsizeMode -> m () setLabelEllipsize obj val = liftIO $ setObjectPropertyEnum obj "ellipsize" val constructLabelEllipsize :: Pango.EllipsizeMode -> IO ([Char], GValue) constructLabelEllipsize val = constructObjectPropertyEnum "ellipsize" val data LabelEllipsizePropertyInfo instance AttrInfo LabelEllipsizePropertyInfo where type AttrAllowedOps LabelEllipsizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelEllipsizePropertyInfo = (~) Pango.EllipsizeMode type AttrBaseTypeConstraint LabelEllipsizePropertyInfo = LabelK type AttrGetType LabelEllipsizePropertyInfo = Pango.EllipsizeMode type AttrLabel LabelEllipsizePropertyInfo = "Label::ellipsize" attrGet _ = getLabelEllipsize attrSet _ = setLabelEllipsize attrConstruct _ = constructLabelEllipsize -- VVV Prop "justify" -- Type: TInterface "Gtk" "Justification" -- Flags: [PropertyReadable,PropertyWritable] getLabelJustify :: (MonadIO m, LabelK o) => o -> m Justification getLabelJustify obj = liftIO $ getObjectPropertyEnum obj "justify" setLabelJustify :: (MonadIO m, LabelK o) => o -> Justification -> m () setLabelJustify obj val = liftIO $ setObjectPropertyEnum obj "justify" val constructLabelJustify :: Justification -> IO ([Char], GValue) constructLabelJustify val = constructObjectPropertyEnum "justify" val data LabelJustifyPropertyInfo instance AttrInfo LabelJustifyPropertyInfo where type AttrAllowedOps LabelJustifyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelJustifyPropertyInfo = (~) Justification type AttrBaseTypeConstraint LabelJustifyPropertyInfo = LabelK type AttrGetType LabelJustifyPropertyInfo = Justification type AttrLabel LabelJustifyPropertyInfo = "Label::justify" attrGet _ = getLabelJustify attrSet _ = setLabelJustify attrConstruct _ = constructLabelJustify -- VVV Prop "label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getLabelLabel :: (MonadIO m, LabelK o) => o -> m T.Text getLabelLabel obj = liftIO $ getObjectPropertyString obj "label" setLabelLabel :: (MonadIO m, LabelK o) => o -> T.Text -> m () setLabelLabel obj val = liftIO $ setObjectPropertyString obj "label" val constructLabelLabel :: T.Text -> IO ([Char], GValue) constructLabelLabel val = constructObjectPropertyString "label" val data LabelLabelPropertyInfo instance AttrInfo LabelLabelPropertyInfo where type AttrAllowedOps LabelLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint LabelLabelPropertyInfo = LabelK type AttrGetType LabelLabelPropertyInfo = T.Text type AttrLabel LabelLabelPropertyInfo = "Label::label" attrGet _ = getLabelLabel attrSet _ = setLabelLabel attrConstruct _ = constructLabelLabel -- VVV Prop "lines" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getLabelLines :: (MonadIO m, LabelK o) => o -> m Int32 getLabelLines obj = liftIO $ getObjectPropertyCInt obj "lines" setLabelLines :: (MonadIO m, LabelK o) => o -> Int32 -> m () setLabelLines obj val = liftIO $ setObjectPropertyCInt obj "lines" val constructLabelLines :: Int32 -> IO ([Char], GValue) constructLabelLines val = constructObjectPropertyCInt "lines" val data LabelLinesPropertyInfo instance AttrInfo LabelLinesPropertyInfo where type AttrAllowedOps LabelLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelLinesPropertyInfo = (~) Int32 type AttrBaseTypeConstraint LabelLinesPropertyInfo = LabelK type AttrGetType LabelLinesPropertyInfo = Int32 type AttrLabel LabelLinesPropertyInfo = "Label::lines" attrGet _ = getLabelLines attrSet _ = setLabelLines attrConstruct _ = constructLabelLines -- VVV Prop "max-width-chars" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getLabelMaxWidthChars :: (MonadIO m, LabelK o) => o -> m Int32 getLabelMaxWidthChars obj = liftIO $ getObjectPropertyCInt obj "max-width-chars" setLabelMaxWidthChars :: (MonadIO m, LabelK o) => o -> Int32 -> m () setLabelMaxWidthChars obj val = liftIO $ setObjectPropertyCInt obj "max-width-chars" val constructLabelMaxWidthChars :: Int32 -> IO ([Char], GValue) constructLabelMaxWidthChars val = constructObjectPropertyCInt "max-width-chars" val data LabelMaxWidthCharsPropertyInfo instance AttrInfo LabelMaxWidthCharsPropertyInfo where type AttrAllowedOps LabelMaxWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelMaxWidthCharsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint LabelMaxWidthCharsPropertyInfo = LabelK type AttrGetType LabelMaxWidthCharsPropertyInfo = Int32 type AttrLabel LabelMaxWidthCharsPropertyInfo = "Label::max-width-chars" attrGet _ = getLabelMaxWidthChars attrSet _ = setLabelMaxWidthChars attrConstruct _ = constructLabelMaxWidthChars -- VVV Prop "mnemonic-keyval" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable] getLabelMnemonicKeyval :: (MonadIO m, LabelK o) => o -> m Word32 getLabelMnemonicKeyval obj = liftIO $ getObjectPropertyCUInt obj "mnemonic-keyval" data LabelMnemonicKeyvalPropertyInfo instance AttrInfo LabelMnemonicKeyvalPropertyInfo where type AttrAllowedOps LabelMnemonicKeyvalPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint LabelMnemonicKeyvalPropertyInfo = (~) () type AttrBaseTypeConstraint LabelMnemonicKeyvalPropertyInfo = LabelK type AttrGetType LabelMnemonicKeyvalPropertyInfo = Word32 type AttrLabel LabelMnemonicKeyvalPropertyInfo = "Label::mnemonic-keyval" attrGet _ = getLabelMnemonicKeyval attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "mnemonic-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getLabelMnemonicWidget :: (MonadIO m, LabelK o) => o -> m Widget getLabelMnemonicWidget obj = liftIO $ getObjectPropertyObject obj "mnemonic-widget" Widget setLabelMnemonicWidget :: (MonadIO m, LabelK o, WidgetK a) => o -> a -> m () setLabelMnemonicWidget obj val = liftIO $ setObjectPropertyObject obj "mnemonic-widget" val constructLabelMnemonicWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructLabelMnemonicWidget val = constructObjectPropertyObject "mnemonic-widget" val data LabelMnemonicWidgetPropertyInfo instance AttrInfo LabelMnemonicWidgetPropertyInfo where type AttrAllowedOps LabelMnemonicWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelMnemonicWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint LabelMnemonicWidgetPropertyInfo = LabelK type AttrGetType LabelMnemonicWidgetPropertyInfo = Widget type AttrLabel LabelMnemonicWidgetPropertyInfo = "Label::mnemonic-widget" attrGet _ = getLabelMnemonicWidget attrSet _ = setLabelMnemonicWidget attrConstruct _ = constructLabelMnemonicWidget -- VVV Prop "pattern" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setLabelPattern :: (MonadIO m, LabelK o) => o -> T.Text -> m () setLabelPattern obj val = liftIO $ setObjectPropertyString obj "pattern" val constructLabelPattern :: T.Text -> IO ([Char], GValue) constructLabelPattern val = constructObjectPropertyString "pattern" val data LabelPatternPropertyInfo instance AttrInfo LabelPatternPropertyInfo where type AttrAllowedOps LabelPatternPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint LabelPatternPropertyInfo = (~) T.Text type AttrBaseTypeConstraint LabelPatternPropertyInfo = LabelK type AttrGetType LabelPatternPropertyInfo = () type AttrLabel LabelPatternPropertyInfo = "Label::pattern" attrGet _ = undefined attrSet _ = setLabelPattern attrConstruct _ = constructLabelPattern -- VVV Prop "selectable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getLabelSelectable :: (MonadIO m, LabelK o) => o -> m Bool getLabelSelectable obj = liftIO $ getObjectPropertyBool obj "selectable" setLabelSelectable :: (MonadIO m, LabelK o) => o -> Bool -> m () setLabelSelectable obj val = liftIO $ setObjectPropertyBool obj "selectable" val constructLabelSelectable :: Bool -> IO ([Char], GValue) constructLabelSelectable val = constructObjectPropertyBool "selectable" val data LabelSelectablePropertyInfo instance AttrInfo LabelSelectablePropertyInfo where type AttrAllowedOps LabelSelectablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelSelectablePropertyInfo = (~) Bool type AttrBaseTypeConstraint LabelSelectablePropertyInfo = LabelK type AttrGetType LabelSelectablePropertyInfo = Bool type AttrLabel LabelSelectablePropertyInfo = "Label::selectable" attrGet _ = getLabelSelectable attrSet _ = setLabelSelectable attrConstruct _ = constructLabelSelectable -- VVV Prop "selection-bound" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getLabelSelectionBound :: (MonadIO m, LabelK o) => o -> m Int32 getLabelSelectionBound obj = liftIO $ getObjectPropertyCInt obj "selection-bound" data LabelSelectionBoundPropertyInfo instance AttrInfo LabelSelectionBoundPropertyInfo where type AttrAllowedOps LabelSelectionBoundPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint LabelSelectionBoundPropertyInfo = (~) () type AttrBaseTypeConstraint LabelSelectionBoundPropertyInfo = LabelK type AttrGetType LabelSelectionBoundPropertyInfo = Int32 type AttrLabel LabelSelectionBoundPropertyInfo = "Label::selection-bound" attrGet _ = getLabelSelectionBound attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "single-line-mode" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getLabelSingleLineMode :: (MonadIO m, LabelK o) => o -> m Bool getLabelSingleLineMode obj = liftIO $ getObjectPropertyBool obj "single-line-mode" setLabelSingleLineMode :: (MonadIO m, LabelK o) => o -> Bool -> m () setLabelSingleLineMode obj val = liftIO $ setObjectPropertyBool obj "single-line-mode" val constructLabelSingleLineMode :: Bool -> IO ([Char], GValue) constructLabelSingleLineMode val = constructObjectPropertyBool "single-line-mode" val data LabelSingleLineModePropertyInfo instance AttrInfo LabelSingleLineModePropertyInfo where type AttrAllowedOps LabelSingleLineModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelSingleLineModePropertyInfo = (~) Bool type AttrBaseTypeConstraint LabelSingleLineModePropertyInfo = LabelK type AttrGetType LabelSingleLineModePropertyInfo = Bool type AttrLabel LabelSingleLineModePropertyInfo = "Label::single-line-mode" attrGet _ = getLabelSingleLineMode attrSet _ = setLabelSingleLineMode attrConstruct _ = constructLabelSingleLineMode -- VVV Prop "track-visited-links" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getLabelTrackVisitedLinks :: (MonadIO m, LabelK o) => o -> m Bool getLabelTrackVisitedLinks obj = liftIO $ getObjectPropertyBool obj "track-visited-links" setLabelTrackVisitedLinks :: (MonadIO m, LabelK o) => o -> Bool -> m () setLabelTrackVisitedLinks obj val = liftIO $ setObjectPropertyBool obj "track-visited-links" val constructLabelTrackVisitedLinks :: Bool -> IO ([Char], GValue) constructLabelTrackVisitedLinks val = constructObjectPropertyBool "track-visited-links" val data LabelTrackVisitedLinksPropertyInfo instance AttrInfo LabelTrackVisitedLinksPropertyInfo where type AttrAllowedOps LabelTrackVisitedLinksPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelTrackVisitedLinksPropertyInfo = (~) Bool type AttrBaseTypeConstraint LabelTrackVisitedLinksPropertyInfo = LabelK type AttrGetType LabelTrackVisitedLinksPropertyInfo = Bool type AttrLabel LabelTrackVisitedLinksPropertyInfo = "Label::track-visited-links" attrGet _ = getLabelTrackVisitedLinks attrSet _ = setLabelTrackVisitedLinks attrConstruct _ = constructLabelTrackVisitedLinks -- VVV Prop "use-markup" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getLabelUseMarkup :: (MonadIO m, LabelK o) => o -> m Bool getLabelUseMarkup obj = liftIO $ getObjectPropertyBool obj "use-markup" setLabelUseMarkup :: (MonadIO m, LabelK o) => o -> Bool -> m () setLabelUseMarkup obj val = liftIO $ setObjectPropertyBool obj "use-markup" val constructLabelUseMarkup :: Bool -> IO ([Char], GValue) constructLabelUseMarkup val = constructObjectPropertyBool "use-markup" val data LabelUseMarkupPropertyInfo instance AttrInfo LabelUseMarkupPropertyInfo where type AttrAllowedOps LabelUseMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelUseMarkupPropertyInfo = (~) Bool type AttrBaseTypeConstraint LabelUseMarkupPropertyInfo = LabelK type AttrGetType LabelUseMarkupPropertyInfo = Bool type AttrLabel LabelUseMarkupPropertyInfo = "Label::use-markup" attrGet _ = getLabelUseMarkup attrSet _ = setLabelUseMarkup attrConstruct _ = constructLabelUseMarkup -- VVV Prop "use-underline" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getLabelUseUnderline :: (MonadIO m, LabelK o) => o -> m Bool getLabelUseUnderline obj = liftIO $ getObjectPropertyBool obj "use-underline" setLabelUseUnderline :: (MonadIO m, LabelK o) => o -> Bool -> m () setLabelUseUnderline obj val = liftIO $ setObjectPropertyBool obj "use-underline" val constructLabelUseUnderline :: Bool -> IO ([Char], GValue) constructLabelUseUnderline val = constructObjectPropertyBool "use-underline" val data LabelUseUnderlinePropertyInfo instance AttrInfo LabelUseUnderlinePropertyInfo where type AttrAllowedOps LabelUseUnderlinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelUseUnderlinePropertyInfo = (~) Bool type AttrBaseTypeConstraint LabelUseUnderlinePropertyInfo = LabelK type AttrGetType LabelUseUnderlinePropertyInfo = Bool type AttrLabel LabelUseUnderlinePropertyInfo = "Label::use-underline" attrGet _ = getLabelUseUnderline attrSet _ = setLabelUseUnderline attrConstruct _ = constructLabelUseUnderline -- VVV Prop "width-chars" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getLabelWidthChars :: (MonadIO m, LabelK o) => o -> m Int32 getLabelWidthChars obj = liftIO $ getObjectPropertyCInt obj "width-chars" setLabelWidthChars :: (MonadIO m, LabelK o) => o -> Int32 -> m () setLabelWidthChars obj val = liftIO $ setObjectPropertyCInt obj "width-chars" val constructLabelWidthChars :: Int32 -> IO ([Char], GValue) constructLabelWidthChars val = constructObjectPropertyCInt "width-chars" val data LabelWidthCharsPropertyInfo instance AttrInfo LabelWidthCharsPropertyInfo where type AttrAllowedOps LabelWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelWidthCharsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint LabelWidthCharsPropertyInfo = LabelK type AttrGetType LabelWidthCharsPropertyInfo = Int32 type AttrLabel LabelWidthCharsPropertyInfo = "Label::width-chars" attrGet _ = getLabelWidthChars attrSet _ = setLabelWidthChars attrConstruct _ = constructLabelWidthChars -- VVV Prop "wrap" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getLabelWrap :: (MonadIO m, LabelK o) => o -> m Bool getLabelWrap obj = liftIO $ getObjectPropertyBool obj "wrap" setLabelWrap :: (MonadIO m, LabelK o) => o -> Bool -> m () setLabelWrap obj val = liftIO $ setObjectPropertyBool obj "wrap" val constructLabelWrap :: Bool -> IO ([Char], GValue) constructLabelWrap val = constructObjectPropertyBool "wrap" val data LabelWrapPropertyInfo instance AttrInfo LabelWrapPropertyInfo where type AttrAllowedOps LabelWrapPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelWrapPropertyInfo = (~) Bool type AttrBaseTypeConstraint LabelWrapPropertyInfo = LabelK type AttrGetType LabelWrapPropertyInfo = Bool type AttrLabel LabelWrapPropertyInfo = "Label::wrap" attrGet _ = getLabelWrap attrSet _ = setLabelWrap attrConstruct _ = constructLabelWrap -- VVV Prop "wrap-mode" -- Type: TInterface "Pango" "WrapMode" -- Flags: [PropertyReadable,PropertyWritable] getLabelWrapMode :: (MonadIO m, LabelK o) => o -> m Pango.WrapMode getLabelWrapMode obj = liftIO $ getObjectPropertyEnum obj "wrap-mode" setLabelWrapMode :: (MonadIO m, LabelK o) => o -> Pango.WrapMode -> m () setLabelWrapMode obj val = liftIO $ setObjectPropertyEnum obj "wrap-mode" val constructLabelWrapMode :: Pango.WrapMode -> IO ([Char], GValue) constructLabelWrapMode val = constructObjectPropertyEnum "wrap-mode" val data LabelWrapModePropertyInfo instance AttrInfo LabelWrapModePropertyInfo where type AttrAllowedOps LabelWrapModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelWrapModePropertyInfo = (~) Pango.WrapMode type AttrBaseTypeConstraint LabelWrapModePropertyInfo = LabelK type AttrGetType LabelWrapModePropertyInfo = Pango.WrapMode type AttrLabel LabelWrapModePropertyInfo = "Label::wrap-mode" attrGet _ = getLabelWrapMode attrSet _ = setLabelWrapMode attrConstruct _ = constructLabelWrapMode -- VVV Prop "xalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getLabelXalign :: (MonadIO m, LabelK o) => o -> m Float getLabelXalign obj = liftIO $ getObjectPropertyFloat obj "xalign" setLabelXalign :: (MonadIO m, LabelK o) => o -> Float -> m () setLabelXalign obj val = liftIO $ setObjectPropertyFloat obj "xalign" val constructLabelXalign :: Float -> IO ([Char], GValue) constructLabelXalign val = constructObjectPropertyFloat "xalign" val data LabelXalignPropertyInfo instance AttrInfo LabelXalignPropertyInfo where type AttrAllowedOps LabelXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelXalignPropertyInfo = (~) Float type AttrBaseTypeConstraint LabelXalignPropertyInfo = LabelK type AttrGetType LabelXalignPropertyInfo = Float type AttrLabel LabelXalignPropertyInfo = "Label::xalign" attrGet _ = getLabelXalign attrSet _ = setLabelXalign attrConstruct _ = constructLabelXalign -- VVV Prop "yalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getLabelYalign :: (MonadIO m, LabelK o) => o -> m Float getLabelYalign obj = liftIO $ getObjectPropertyFloat obj "yalign" setLabelYalign :: (MonadIO m, LabelK o) => o -> Float -> m () setLabelYalign obj val = liftIO $ setObjectPropertyFloat obj "yalign" val constructLabelYalign :: Float -> IO ([Char], GValue) constructLabelYalign val = constructObjectPropertyFloat "yalign" val data LabelYalignPropertyInfo instance AttrInfo LabelYalignPropertyInfo where type AttrAllowedOps LabelYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LabelYalignPropertyInfo = (~) Float type AttrBaseTypeConstraint LabelYalignPropertyInfo = LabelK type AttrGetType LabelYalignPropertyInfo = Float type AttrLabel LabelYalignPropertyInfo = "Label::yalign" attrGet _ = getLabelYalign attrSet _ = setLabelYalign attrConstruct _ = constructLabelYalign type instance AttributeList Label = '[ '("angle", LabelAnglePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("attributes", LabelAttributesPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("cursor-position", LabelCursorPositionPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("ellipsize", LabelEllipsizePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("justify", LabelJustifyPropertyInfo), '("label", LabelLabelPropertyInfo), '("lines", LabelLinesPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-width-chars", LabelMaxWidthCharsPropertyInfo), '("mnemonic-keyval", LabelMnemonicKeyvalPropertyInfo), '("mnemonic-widget", LabelMnemonicWidgetPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("pattern", LabelPatternPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("selectable", LabelSelectablePropertyInfo), '("selection-bound", LabelSelectionBoundPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("single-line-mode", LabelSingleLineModePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("track-visited-links", LabelTrackVisitedLinksPropertyInfo), '("use-markup", LabelUseMarkupPropertyInfo), '("use-underline", LabelUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-chars", LabelWidthCharsPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("wrap", LabelWrapPropertyInfo), '("wrap-mode", LabelWrapModePropertyInfo), '("xpad", MiscXpadPropertyInfo), '("ypad", MiscYpadPropertyInfo)] type instance AttributeList LabelAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "height" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getLayoutHeight :: (MonadIO m, LayoutK o) => o -> m Word32 getLayoutHeight obj = liftIO $ getObjectPropertyCUInt obj "height" setLayoutHeight :: (MonadIO m, LayoutK o) => o -> Word32 -> m () setLayoutHeight obj val = liftIO $ setObjectPropertyCUInt obj "height" val constructLayoutHeight :: Word32 -> IO ([Char], GValue) constructLayoutHeight val = constructObjectPropertyCUInt "height" val data LayoutHeightPropertyInfo instance AttrInfo LayoutHeightPropertyInfo where type AttrAllowedOps LayoutHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LayoutHeightPropertyInfo = (~) Word32 type AttrBaseTypeConstraint LayoutHeightPropertyInfo = LayoutK type AttrGetType LayoutHeightPropertyInfo = Word32 type AttrLabel LayoutHeightPropertyInfo = "Layout::height" attrGet _ = getLayoutHeight attrSet _ = setLayoutHeight attrConstruct _ = constructLayoutHeight -- VVV Prop "width" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getLayoutWidth :: (MonadIO m, LayoutK o) => o -> m Word32 getLayoutWidth obj = liftIO $ getObjectPropertyCUInt obj "width" setLayoutWidth :: (MonadIO m, LayoutK o) => o -> Word32 -> m () setLayoutWidth obj val = liftIO $ setObjectPropertyCUInt obj "width" val constructLayoutWidth :: Word32 -> IO ([Char], GValue) constructLayoutWidth val = constructObjectPropertyCUInt "width" val data LayoutWidthPropertyInfo instance AttrInfo LayoutWidthPropertyInfo where type AttrAllowedOps LayoutWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LayoutWidthPropertyInfo = (~) Word32 type AttrBaseTypeConstraint LayoutWidthPropertyInfo = LayoutK type AttrGetType LayoutWidthPropertyInfo = Word32 type AttrLabel LayoutWidthPropertyInfo = "Layout::width" attrGet _ = getLayoutWidth attrSet _ = setLayoutWidth attrConstruct _ = constructLayoutWidth type instance AttributeList Layout = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("hadjustment", ScrollableHadjustmentPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height", LayoutHeightPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hscroll-policy", ScrollableHscrollPolicyPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("vadjustment", ScrollableVadjustmentPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("vscroll-policy", ScrollableVscrollPolicyPropertyInfo), '("width", LayoutWidthPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "inverted" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getLevelBarInverted :: (MonadIO m, LevelBarK o) => o -> m Bool getLevelBarInverted obj = liftIO $ getObjectPropertyBool obj "inverted" setLevelBarInverted :: (MonadIO m, LevelBarK o) => o -> Bool -> m () setLevelBarInverted obj val = liftIO $ setObjectPropertyBool obj "inverted" val constructLevelBarInverted :: Bool -> IO ([Char], GValue) constructLevelBarInverted val = constructObjectPropertyBool "inverted" val data LevelBarInvertedPropertyInfo instance AttrInfo LevelBarInvertedPropertyInfo where type AttrAllowedOps LevelBarInvertedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LevelBarInvertedPropertyInfo = (~) Bool type AttrBaseTypeConstraint LevelBarInvertedPropertyInfo = LevelBarK type AttrGetType LevelBarInvertedPropertyInfo = Bool type AttrLabel LevelBarInvertedPropertyInfo = "LevelBar::inverted" attrGet _ = getLevelBarInverted attrSet _ = setLevelBarInverted attrConstruct _ = constructLevelBarInverted -- VVV Prop "max-value" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getLevelBarMaxValue :: (MonadIO m, LevelBarK o) => o -> m Double getLevelBarMaxValue obj = liftIO $ getObjectPropertyDouble obj "max-value" setLevelBarMaxValue :: (MonadIO m, LevelBarK o) => o -> Double -> m () setLevelBarMaxValue obj val = liftIO $ setObjectPropertyDouble obj "max-value" val constructLevelBarMaxValue :: Double -> IO ([Char], GValue) constructLevelBarMaxValue val = constructObjectPropertyDouble "max-value" val data LevelBarMaxValuePropertyInfo instance AttrInfo LevelBarMaxValuePropertyInfo where type AttrAllowedOps LevelBarMaxValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LevelBarMaxValuePropertyInfo = (~) Double type AttrBaseTypeConstraint LevelBarMaxValuePropertyInfo = LevelBarK type AttrGetType LevelBarMaxValuePropertyInfo = Double type AttrLabel LevelBarMaxValuePropertyInfo = "LevelBar::max-value" attrGet _ = getLevelBarMaxValue attrSet _ = setLevelBarMaxValue attrConstruct _ = constructLevelBarMaxValue -- VVV Prop "min-value" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getLevelBarMinValue :: (MonadIO m, LevelBarK o) => o -> m Double getLevelBarMinValue obj = liftIO $ getObjectPropertyDouble obj "min-value" setLevelBarMinValue :: (MonadIO m, LevelBarK o) => o -> Double -> m () setLevelBarMinValue obj val = liftIO $ setObjectPropertyDouble obj "min-value" val constructLevelBarMinValue :: Double -> IO ([Char], GValue) constructLevelBarMinValue val = constructObjectPropertyDouble "min-value" val data LevelBarMinValuePropertyInfo instance AttrInfo LevelBarMinValuePropertyInfo where type AttrAllowedOps LevelBarMinValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LevelBarMinValuePropertyInfo = (~) Double type AttrBaseTypeConstraint LevelBarMinValuePropertyInfo = LevelBarK type AttrGetType LevelBarMinValuePropertyInfo = Double type AttrLabel LevelBarMinValuePropertyInfo = "LevelBar::min-value" attrGet _ = getLevelBarMinValue attrSet _ = setLevelBarMinValue attrConstruct _ = constructLevelBarMinValue -- VVV Prop "mode" -- Type: TInterface "Gtk" "LevelBarMode" -- Flags: [PropertyReadable,PropertyWritable] getLevelBarMode :: (MonadIO m, LevelBarK o) => o -> m LevelBarMode getLevelBarMode obj = liftIO $ getObjectPropertyEnum obj "mode" setLevelBarMode :: (MonadIO m, LevelBarK o) => o -> LevelBarMode -> m () setLevelBarMode obj val = liftIO $ setObjectPropertyEnum obj "mode" val constructLevelBarMode :: LevelBarMode -> IO ([Char], GValue) constructLevelBarMode val = constructObjectPropertyEnum "mode" val data LevelBarModePropertyInfo instance AttrInfo LevelBarModePropertyInfo where type AttrAllowedOps LevelBarModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LevelBarModePropertyInfo = (~) LevelBarMode type AttrBaseTypeConstraint LevelBarModePropertyInfo = LevelBarK type AttrGetType LevelBarModePropertyInfo = LevelBarMode type AttrLabel LevelBarModePropertyInfo = "LevelBar::mode" attrGet _ = getLevelBarMode attrSet _ = setLevelBarMode attrConstruct _ = constructLevelBarMode -- VVV Prop "value" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getLevelBarValue :: (MonadIO m, LevelBarK o) => o -> m Double getLevelBarValue obj = liftIO $ getObjectPropertyDouble obj "value" setLevelBarValue :: (MonadIO m, LevelBarK o) => o -> Double -> m () setLevelBarValue obj val = liftIO $ setObjectPropertyDouble obj "value" val constructLevelBarValue :: Double -> IO ([Char], GValue) constructLevelBarValue val = constructObjectPropertyDouble "value" val data LevelBarValuePropertyInfo instance AttrInfo LevelBarValuePropertyInfo where type AttrAllowedOps LevelBarValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LevelBarValuePropertyInfo = (~) Double type AttrBaseTypeConstraint LevelBarValuePropertyInfo = LevelBarK type AttrGetType LevelBarValuePropertyInfo = Double type AttrLabel LevelBarValuePropertyInfo = "LevelBar::value" attrGet _ = getLevelBarValue attrSet _ = setLevelBarValue attrConstruct _ = constructLevelBarValue type instance AttributeList LevelBar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inverted", LevelBarInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-value", LevelBarMaxValuePropertyInfo), '("min-value", LevelBarMinValuePropertyInfo), '("mode", LevelBarModePropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("value", LevelBarValuePropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList LevelBarAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "uri" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getLinkButtonUri :: (MonadIO m, LinkButtonK o) => o -> m T.Text getLinkButtonUri obj = liftIO $ getObjectPropertyString obj "uri" setLinkButtonUri :: (MonadIO m, LinkButtonK o) => o -> T.Text -> m () setLinkButtonUri obj val = liftIO $ setObjectPropertyString obj "uri" val constructLinkButtonUri :: T.Text -> IO ([Char], GValue) constructLinkButtonUri val = constructObjectPropertyString "uri" val data LinkButtonUriPropertyInfo instance AttrInfo LinkButtonUriPropertyInfo where type AttrAllowedOps LinkButtonUriPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LinkButtonUriPropertyInfo = (~) T.Text type AttrBaseTypeConstraint LinkButtonUriPropertyInfo = LinkButtonK type AttrGetType LinkButtonUriPropertyInfo = T.Text type AttrLabel LinkButtonUriPropertyInfo = "LinkButton::uri" attrGet _ = getLinkButtonUri attrSet _ = setLinkButtonUri attrConstruct _ = constructLinkButtonUri -- VVV Prop "visited" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getLinkButtonVisited :: (MonadIO m, LinkButtonK o) => o -> m Bool getLinkButtonVisited obj = liftIO $ getObjectPropertyBool obj "visited" setLinkButtonVisited :: (MonadIO m, LinkButtonK o) => o -> Bool -> m () setLinkButtonVisited obj val = liftIO $ setObjectPropertyBool obj "visited" val constructLinkButtonVisited :: Bool -> IO ([Char], GValue) constructLinkButtonVisited val = constructObjectPropertyBool "visited" val data LinkButtonVisitedPropertyInfo instance AttrInfo LinkButtonVisitedPropertyInfo where type AttrAllowedOps LinkButtonVisitedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LinkButtonVisitedPropertyInfo = (~) Bool type AttrBaseTypeConstraint LinkButtonVisitedPropertyInfo = LinkButtonK type AttrGetType LinkButtonVisitedPropertyInfo = Bool type AttrLabel LinkButtonVisitedPropertyInfo = "LinkButton::visited" attrGet _ = getLinkButtonVisited attrSet _ = setLinkButtonVisited attrConstruct _ = constructLinkButtonVisited type instance AttributeList LinkButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("uri", LinkButtonUriPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("visited", LinkButtonVisitedPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] type instance AttributeList LinkButtonAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "activate-on-single-click" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getListBoxActivateOnSingleClick :: (MonadIO m, ListBoxK o) => o -> m Bool getListBoxActivateOnSingleClick obj = liftIO $ getObjectPropertyBool obj "activate-on-single-click" setListBoxActivateOnSingleClick :: (MonadIO m, ListBoxK o) => o -> Bool -> m () setListBoxActivateOnSingleClick obj val = liftIO $ setObjectPropertyBool obj "activate-on-single-click" val constructListBoxActivateOnSingleClick :: Bool -> IO ([Char], GValue) constructListBoxActivateOnSingleClick val = constructObjectPropertyBool "activate-on-single-click" val data ListBoxActivateOnSingleClickPropertyInfo instance AttrInfo ListBoxActivateOnSingleClickPropertyInfo where type AttrAllowedOps ListBoxActivateOnSingleClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ListBoxActivateOnSingleClickPropertyInfo = (~) Bool type AttrBaseTypeConstraint ListBoxActivateOnSingleClickPropertyInfo = ListBoxK type AttrGetType ListBoxActivateOnSingleClickPropertyInfo = Bool type AttrLabel ListBoxActivateOnSingleClickPropertyInfo = "ListBox::activate-on-single-click" attrGet _ = getListBoxActivateOnSingleClick attrSet _ = setListBoxActivateOnSingleClick attrConstruct _ = constructListBoxActivateOnSingleClick -- VVV Prop "selection-mode" -- Type: TInterface "Gtk" "SelectionMode" -- Flags: [PropertyReadable,PropertyWritable] getListBoxSelectionMode :: (MonadIO m, ListBoxK o) => o -> m SelectionMode getListBoxSelectionMode obj = liftIO $ getObjectPropertyEnum obj "selection-mode" setListBoxSelectionMode :: (MonadIO m, ListBoxK o) => o -> SelectionMode -> m () setListBoxSelectionMode obj val = liftIO $ setObjectPropertyEnum obj "selection-mode" val constructListBoxSelectionMode :: SelectionMode -> IO ([Char], GValue) constructListBoxSelectionMode val = constructObjectPropertyEnum "selection-mode" val data ListBoxSelectionModePropertyInfo instance AttrInfo ListBoxSelectionModePropertyInfo where type AttrAllowedOps ListBoxSelectionModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ListBoxSelectionModePropertyInfo = (~) SelectionMode type AttrBaseTypeConstraint ListBoxSelectionModePropertyInfo = ListBoxK type AttrGetType ListBoxSelectionModePropertyInfo = SelectionMode type AttrLabel ListBoxSelectionModePropertyInfo = "ListBox::selection-mode" attrGet _ = getListBoxSelectionMode attrSet _ = setListBoxSelectionMode attrConstruct _ = constructListBoxSelectionMode type instance AttributeList ListBox = '[ '("activate-on-single-click", ListBoxActivateOnSingleClickPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("selection-mode", ListBoxSelectionModePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList ListBoxAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "activatable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getListBoxRowActivatable :: (MonadIO m, ListBoxRowK o) => o -> m Bool getListBoxRowActivatable obj = liftIO $ getObjectPropertyBool obj "activatable" setListBoxRowActivatable :: (MonadIO m, ListBoxRowK o) => o -> Bool -> m () setListBoxRowActivatable obj val = liftIO $ setObjectPropertyBool obj "activatable" val constructListBoxRowActivatable :: Bool -> IO ([Char], GValue) constructListBoxRowActivatable val = constructObjectPropertyBool "activatable" val data ListBoxRowActivatablePropertyInfo instance AttrInfo ListBoxRowActivatablePropertyInfo where type AttrAllowedOps ListBoxRowActivatablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ListBoxRowActivatablePropertyInfo = (~) Bool type AttrBaseTypeConstraint ListBoxRowActivatablePropertyInfo = ListBoxRowK type AttrGetType ListBoxRowActivatablePropertyInfo = Bool type AttrLabel ListBoxRowActivatablePropertyInfo = "ListBoxRow::activatable" attrGet _ = getListBoxRowActivatable attrSet _ = setListBoxRowActivatable attrConstruct _ = constructListBoxRowActivatable -- VVV Prop "selectable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getListBoxRowSelectable :: (MonadIO m, ListBoxRowK o) => o -> m Bool getListBoxRowSelectable obj = liftIO $ getObjectPropertyBool obj "selectable" setListBoxRowSelectable :: (MonadIO m, ListBoxRowK o) => o -> Bool -> m () setListBoxRowSelectable obj val = liftIO $ setObjectPropertyBool obj "selectable" val constructListBoxRowSelectable :: Bool -> IO ([Char], GValue) constructListBoxRowSelectable val = constructObjectPropertyBool "selectable" val data ListBoxRowSelectablePropertyInfo instance AttrInfo ListBoxRowSelectablePropertyInfo where type AttrAllowedOps ListBoxRowSelectablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ListBoxRowSelectablePropertyInfo = (~) Bool type AttrBaseTypeConstraint ListBoxRowSelectablePropertyInfo = ListBoxRowK type AttrGetType ListBoxRowSelectablePropertyInfo = Bool type AttrLabel ListBoxRowSelectablePropertyInfo = "ListBoxRow::selectable" attrGet _ = getListBoxRowSelectable attrSet _ = setListBoxRowSelectable attrConstruct _ = constructListBoxRowSelectable type instance AttributeList ListBoxRow = '[ '("activatable", ListBoxRowActivatablePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("selectable", ListBoxRowSelectablePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList ListBoxRowAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList ListStore = '[ ] -- VVV Prop "permission" -- Type: TInterface "Gio" "Permission" -- Flags: [PropertyReadable,PropertyWritable] getLockButtonPermission :: (MonadIO m, LockButtonK o) => o -> m Gio.Permission getLockButtonPermission obj = liftIO $ getObjectPropertyObject obj "permission" Gio.Permission setLockButtonPermission :: (MonadIO m, LockButtonK o, Gio.PermissionK a) => o -> a -> m () setLockButtonPermission obj val = liftIO $ setObjectPropertyObject obj "permission" val constructLockButtonPermission :: (Gio.PermissionK a) => a -> IO ([Char], GValue) constructLockButtonPermission val = constructObjectPropertyObject "permission" val data LockButtonPermissionPropertyInfo instance AttrInfo LockButtonPermissionPropertyInfo where type AttrAllowedOps LockButtonPermissionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LockButtonPermissionPropertyInfo = Gio.PermissionK type AttrBaseTypeConstraint LockButtonPermissionPropertyInfo = LockButtonK type AttrGetType LockButtonPermissionPropertyInfo = Gio.Permission type AttrLabel LockButtonPermissionPropertyInfo = "LockButton::permission" attrGet _ = getLockButtonPermission attrSet _ = setLockButtonPermission attrConstruct _ = constructLockButtonPermission -- VVV Prop "text-lock" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getLockButtonTextLock :: (MonadIO m, LockButtonK o) => o -> m T.Text getLockButtonTextLock obj = liftIO $ getObjectPropertyString obj "text-lock" setLockButtonTextLock :: (MonadIO m, LockButtonK o) => o -> T.Text -> m () setLockButtonTextLock obj val = liftIO $ setObjectPropertyString obj "text-lock" val constructLockButtonTextLock :: T.Text -> IO ([Char], GValue) constructLockButtonTextLock val = constructObjectPropertyString "text-lock" val data LockButtonTextLockPropertyInfo instance AttrInfo LockButtonTextLockPropertyInfo where type AttrAllowedOps LockButtonTextLockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LockButtonTextLockPropertyInfo = (~) T.Text type AttrBaseTypeConstraint LockButtonTextLockPropertyInfo = LockButtonK type AttrGetType LockButtonTextLockPropertyInfo = T.Text type AttrLabel LockButtonTextLockPropertyInfo = "LockButton::text-lock" attrGet _ = getLockButtonTextLock attrSet _ = setLockButtonTextLock attrConstruct _ = constructLockButtonTextLock -- VVV Prop "text-unlock" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getLockButtonTextUnlock :: (MonadIO m, LockButtonK o) => o -> m T.Text getLockButtonTextUnlock obj = liftIO $ getObjectPropertyString obj "text-unlock" setLockButtonTextUnlock :: (MonadIO m, LockButtonK o) => o -> T.Text -> m () setLockButtonTextUnlock obj val = liftIO $ setObjectPropertyString obj "text-unlock" val constructLockButtonTextUnlock :: T.Text -> IO ([Char], GValue) constructLockButtonTextUnlock val = constructObjectPropertyString "text-unlock" val data LockButtonTextUnlockPropertyInfo instance AttrInfo LockButtonTextUnlockPropertyInfo where type AttrAllowedOps LockButtonTextUnlockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LockButtonTextUnlockPropertyInfo = (~) T.Text type AttrBaseTypeConstraint LockButtonTextUnlockPropertyInfo = LockButtonK type AttrGetType LockButtonTextUnlockPropertyInfo = T.Text type AttrLabel LockButtonTextUnlockPropertyInfo = "LockButton::text-unlock" attrGet _ = getLockButtonTextUnlock attrSet _ = setLockButtonTextUnlock attrConstruct _ = constructLockButtonTextUnlock -- VVV Prop "tooltip-lock" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getLockButtonTooltipLock :: (MonadIO m, LockButtonK o) => o -> m T.Text getLockButtonTooltipLock obj = liftIO $ getObjectPropertyString obj "tooltip-lock" setLockButtonTooltipLock :: (MonadIO m, LockButtonK o) => o -> T.Text -> m () setLockButtonTooltipLock obj val = liftIO $ setObjectPropertyString obj "tooltip-lock" val constructLockButtonTooltipLock :: T.Text -> IO ([Char], GValue) constructLockButtonTooltipLock val = constructObjectPropertyString "tooltip-lock" val data LockButtonTooltipLockPropertyInfo instance AttrInfo LockButtonTooltipLockPropertyInfo where type AttrAllowedOps LockButtonTooltipLockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LockButtonTooltipLockPropertyInfo = (~) T.Text type AttrBaseTypeConstraint LockButtonTooltipLockPropertyInfo = LockButtonK type AttrGetType LockButtonTooltipLockPropertyInfo = T.Text type AttrLabel LockButtonTooltipLockPropertyInfo = "LockButton::tooltip-lock" attrGet _ = getLockButtonTooltipLock attrSet _ = setLockButtonTooltipLock attrConstruct _ = constructLockButtonTooltipLock -- VVV Prop "tooltip-not-authorized" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getLockButtonTooltipNotAuthorized :: (MonadIO m, LockButtonK o) => o -> m T.Text getLockButtonTooltipNotAuthorized obj = liftIO $ getObjectPropertyString obj "tooltip-not-authorized" setLockButtonTooltipNotAuthorized :: (MonadIO m, LockButtonK o) => o -> T.Text -> m () setLockButtonTooltipNotAuthorized obj val = liftIO $ setObjectPropertyString obj "tooltip-not-authorized" val constructLockButtonTooltipNotAuthorized :: T.Text -> IO ([Char], GValue) constructLockButtonTooltipNotAuthorized val = constructObjectPropertyString "tooltip-not-authorized" val data LockButtonTooltipNotAuthorizedPropertyInfo instance AttrInfo LockButtonTooltipNotAuthorizedPropertyInfo where type AttrAllowedOps LockButtonTooltipNotAuthorizedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LockButtonTooltipNotAuthorizedPropertyInfo = (~) T.Text type AttrBaseTypeConstraint LockButtonTooltipNotAuthorizedPropertyInfo = LockButtonK type AttrGetType LockButtonTooltipNotAuthorizedPropertyInfo = T.Text type AttrLabel LockButtonTooltipNotAuthorizedPropertyInfo = "LockButton::tooltip-not-authorized" attrGet _ = getLockButtonTooltipNotAuthorized attrSet _ = setLockButtonTooltipNotAuthorized attrConstruct _ = constructLockButtonTooltipNotAuthorized -- VVV Prop "tooltip-unlock" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getLockButtonTooltipUnlock :: (MonadIO m, LockButtonK o) => o -> m T.Text getLockButtonTooltipUnlock obj = liftIO $ getObjectPropertyString obj "tooltip-unlock" setLockButtonTooltipUnlock :: (MonadIO m, LockButtonK o) => o -> T.Text -> m () setLockButtonTooltipUnlock obj val = liftIO $ setObjectPropertyString obj "tooltip-unlock" val constructLockButtonTooltipUnlock :: T.Text -> IO ([Char], GValue) constructLockButtonTooltipUnlock val = constructObjectPropertyString "tooltip-unlock" val data LockButtonTooltipUnlockPropertyInfo instance AttrInfo LockButtonTooltipUnlockPropertyInfo where type AttrAllowedOps LockButtonTooltipUnlockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint LockButtonTooltipUnlockPropertyInfo = (~) T.Text type AttrBaseTypeConstraint LockButtonTooltipUnlockPropertyInfo = LockButtonK type AttrGetType LockButtonTooltipUnlockPropertyInfo = T.Text type AttrLabel LockButtonTooltipUnlockPropertyInfo = "LockButton::tooltip-unlock" attrGet _ = getLockButtonTooltipUnlock attrSet _ = setLockButtonTooltipUnlock attrConstruct _ = constructLockButtonTooltipUnlock type instance AttributeList LockButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("permission", LockButtonPermissionPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("text-lock", LockButtonTextLockPropertyInfo), '("text-unlock", LockButtonTextUnlockPropertyInfo), '("tooltip-lock", LockButtonTooltipLockPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-not-authorized", LockButtonTooltipNotAuthorizedPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("tooltip-unlock", LockButtonTooltipUnlockPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] type instance AttributeList LockButtonAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "accel-group" -- Type: TInterface "Gtk" "AccelGroup" -- Flags: [PropertyReadable,PropertyWritable] getMenuAccelGroup :: (MonadIO m, MenuK o) => o -> m AccelGroup getMenuAccelGroup obj = liftIO $ getObjectPropertyObject obj "accel-group" AccelGroup setMenuAccelGroup :: (MonadIO m, MenuK o, AccelGroupK a) => o -> a -> m () setMenuAccelGroup obj val = liftIO $ setObjectPropertyObject obj "accel-group" val constructMenuAccelGroup :: (AccelGroupK a) => a -> IO ([Char], GValue) constructMenuAccelGroup val = constructObjectPropertyObject "accel-group" val data MenuAccelGroupPropertyInfo instance AttrInfo MenuAccelGroupPropertyInfo where type AttrAllowedOps MenuAccelGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuAccelGroupPropertyInfo = AccelGroupK type AttrBaseTypeConstraint MenuAccelGroupPropertyInfo = MenuK type AttrGetType MenuAccelGroupPropertyInfo = AccelGroup type AttrLabel MenuAccelGroupPropertyInfo = "Menu::accel-group" attrGet _ = getMenuAccelGroup attrSet _ = setMenuAccelGroup attrConstruct _ = constructMenuAccelGroup -- VVV Prop "accel-path" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMenuAccelPath :: (MonadIO m, MenuK o) => o -> m T.Text getMenuAccelPath obj = liftIO $ getObjectPropertyString obj "accel-path" setMenuAccelPath :: (MonadIO m, MenuK o) => o -> T.Text -> m () setMenuAccelPath obj val = liftIO $ setObjectPropertyString obj "accel-path" val constructMenuAccelPath :: T.Text -> IO ([Char], GValue) constructMenuAccelPath val = constructObjectPropertyString "accel-path" val data MenuAccelPathPropertyInfo instance AttrInfo MenuAccelPathPropertyInfo where type AttrAllowedOps MenuAccelPathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuAccelPathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint MenuAccelPathPropertyInfo = MenuK type AttrGetType MenuAccelPathPropertyInfo = T.Text type AttrLabel MenuAccelPathPropertyInfo = "Menu::accel-path" attrGet _ = getMenuAccelPath attrSet _ = setMenuAccelPath attrConstruct _ = constructMenuAccelPath -- VVV Prop "active" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getMenuActive :: (MonadIO m, MenuK o) => o -> m Int32 getMenuActive obj = liftIO $ getObjectPropertyCInt obj "active" setMenuActive :: (MonadIO m, MenuK o) => o -> Int32 -> m () setMenuActive obj val = liftIO $ setObjectPropertyCInt obj "active" val constructMenuActive :: Int32 -> IO ([Char], GValue) constructMenuActive val = constructObjectPropertyCInt "active" val data MenuActivePropertyInfo instance AttrInfo MenuActivePropertyInfo where type AttrAllowedOps MenuActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuActivePropertyInfo = (~) Int32 type AttrBaseTypeConstraint MenuActivePropertyInfo = MenuK type AttrGetType MenuActivePropertyInfo = Int32 type AttrLabel MenuActivePropertyInfo = "Menu::active" attrGet _ = getMenuActive attrSet _ = setMenuActive attrConstruct _ = constructMenuActive -- VVV Prop "attach-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getMenuAttachWidget :: (MonadIO m, MenuK o) => o -> m Widget getMenuAttachWidget obj = liftIO $ getObjectPropertyObject obj "attach-widget" Widget setMenuAttachWidget :: (MonadIO m, MenuK o, WidgetK a) => o -> a -> m () setMenuAttachWidget obj val = liftIO $ setObjectPropertyObject obj "attach-widget" val constructMenuAttachWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructMenuAttachWidget val = constructObjectPropertyObject "attach-widget" val data MenuAttachWidgetPropertyInfo instance AttrInfo MenuAttachWidgetPropertyInfo where type AttrAllowedOps MenuAttachWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuAttachWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint MenuAttachWidgetPropertyInfo = MenuK type AttrGetType MenuAttachWidgetPropertyInfo = Widget type AttrLabel MenuAttachWidgetPropertyInfo = "Menu::attach-widget" attrGet _ = getMenuAttachWidget attrSet _ = setMenuAttachWidget attrConstruct _ = constructMenuAttachWidget -- VVV Prop "monitor" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getMenuMonitor :: (MonadIO m, MenuK o) => o -> m Int32 getMenuMonitor obj = liftIO $ getObjectPropertyCInt obj "monitor" setMenuMonitor :: (MonadIO m, MenuK o) => o -> Int32 -> m () setMenuMonitor obj val = liftIO $ setObjectPropertyCInt obj "monitor" val constructMenuMonitor :: Int32 -> IO ([Char], GValue) constructMenuMonitor val = constructObjectPropertyCInt "monitor" val data MenuMonitorPropertyInfo instance AttrInfo MenuMonitorPropertyInfo where type AttrAllowedOps MenuMonitorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuMonitorPropertyInfo = (~) Int32 type AttrBaseTypeConstraint MenuMonitorPropertyInfo = MenuK type AttrGetType MenuMonitorPropertyInfo = Int32 type AttrLabel MenuMonitorPropertyInfo = "Menu::monitor" attrGet _ = getMenuMonitor attrSet _ = setMenuMonitor attrConstruct _ = constructMenuMonitor -- VVV Prop "reserve-toggle-size" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getMenuReserveToggleSize :: (MonadIO m, MenuK o) => o -> m Bool getMenuReserveToggleSize obj = liftIO $ getObjectPropertyBool obj "reserve-toggle-size" setMenuReserveToggleSize :: (MonadIO m, MenuK o) => o -> Bool -> m () setMenuReserveToggleSize obj val = liftIO $ setObjectPropertyBool obj "reserve-toggle-size" val constructMenuReserveToggleSize :: Bool -> IO ([Char], GValue) constructMenuReserveToggleSize val = constructObjectPropertyBool "reserve-toggle-size" val data MenuReserveToggleSizePropertyInfo instance AttrInfo MenuReserveToggleSizePropertyInfo where type AttrAllowedOps MenuReserveToggleSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuReserveToggleSizePropertyInfo = (~) Bool type AttrBaseTypeConstraint MenuReserveToggleSizePropertyInfo = MenuK type AttrGetType MenuReserveToggleSizePropertyInfo = Bool type AttrLabel MenuReserveToggleSizePropertyInfo = "Menu::reserve-toggle-size" attrGet _ = getMenuReserveToggleSize attrSet _ = setMenuReserveToggleSize attrConstruct _ = constructMenuReserveToggleSize -- VVV Prop "tearoff-state" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getMenuTearoffState :: (MonadIO m, MenuK o) => o -> m Bool getMenuTearoffState obj = liftIO $ getObjectPropertyBool obj "tearoff-state" setMenuTearoffState :: (MonadIO m, MenuK o) => o -> Bool -> m () setMenuTearoffState obj val = liftIO $ setObjectPropertyBool obj "tearoff-state" val constructMenuTearoffState :: Bool -> IO ([Char], GValue) constructMenuTearoffState val = constructObjectPropertyBool "tearoff-state" val data MenuTearoffStatePropertyInfo instance AttrInfo MenuTearoffStatePropertyInfo where type AttrAllowedOps MenuTearoffStatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuTearoffStatePropertyInfo = (~) Bool type AttrBaseTypeConstraint MenuTearoffStatePropertyInfo = MenuK type AttrGetType MenuTearoffStatePropertyInfo = Bool type AttrLabel MenuTearoffStatePropertyInfo = "Menu::tearoff-state" attrGet _ = getMenuTearoffState attrSet _ = setMenuTearoffState attrConstruct _ = constructMenuTearoffState -- VVV Prop "tearoff-title" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMenuTearoffTitle :: (MonadIO m, MenuK o) => o -> m T.Text getMenuTearoffTitle obj = liftIO $ getObjectPropertyString obj "tearoff-title" setMenuTearoffTitle :: (MonadIO m, MenuK o) => o -> T.Text -> m () setMenuTearoffTitle obj val = liftIO $ setObjectPropertyString obj "tearoff-title" val constructMenuTearoffTitle :: T.Text -> IO ([Char], GValue) constructMenuTearoffTitle val = constructObjectPropertyString "tearoff-title" val data MenuTearoffTitlePropertyInfo instance AttrInfo MenuTearoffTitlePropertyInfo where type AttrAllowedOps MenuTearoffTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuTearoffTitlePropertyInfo = (~) T.Text type AttrBaseTypeConstraint MenuTearoffTitlePropertyInfo = MenuK type AttrGetType MenuTearoffTitlePropertyInfo = T.Text type AttrLabel MenuTearoffTitlePropertyInfo = "Menu::tearoff-title" attrGet _ = getMenuTearoffTitle attrSet _ = setMenuTearoffTitle attrConstruct _ = constructMenuTearoffTitle type instance AttributeList Menu = '[ '("accel-group", MenuAccelGroupPropertyInfo), '("accel-path", MenuAccelPathPropertyInfo), '("active", MenuActivePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("attach-widget", MenuAttachWidgetPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("monitor", MenuMonitorPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("reserve-toggle-size", MenuReserveToggleSizePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("take-focus", MenuShellTakeFocusPropertyInfo), '("tearoff-state", MenuTearoffStatePropertyInfo), '("tearoff-title", MenuTearoffTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList MenuAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "child-pack-direction" -- Type: TInterface "Gtk" "PackDirection" -- Flags: [PropertyReadable,PropertyWritable] getMenuBarChildPackDirection :: (MonadIO m, MenuBarK o) => o -> m PackDirection getMenuBarChildPackDirection obj = liftIO $ getObjectPropertyEnum obj "child-pack-direction" setMenuBarChildPackDirection :: (MonadIO m, MenuBarK o) => o -> PackDirection -> m () setMenuBarChildPackDirection obj val = liftIO $ setObjectPropertyEnum obj "child-pack-direction" val constructMenuBarChildPackDirection :: PackDirection -> IO ([Char], GValue) constructMenuBarChildPackDirection val = constructObjectPropertyEnum "child-pack-direction" val data MenuBarChildPackDirectionPropertyInfo instance AttrInfo MenuBarChildPackDirectionPropertyInfo where type AttrAllowedOps MenuBarChildPackDirectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuBarChildPackDirectionPropertyInfo = (~) PackDirection type AttrBaseTypeConstraint MenuBarChildPackDirectionPropertyInfo = MenuBarK type AttrGetType MenuBarChildPackDirectionPropertyInfo = PackDirection type AttrLabel MenuBarChildPackDirectionPropertyInfo = "MenuBar::child-pack-direction" attrGet _ = getMenuBarChildPackDirection attrSet _ = setMenuBarChildPackDirection attrConstruct _ = constructMenuBarChildPackDirection -- VVV Prop "pack-direction" -- Type: TInterface "Gtk" "PackDirection" -- Flags: [PropertyReadable,PropertyWritable] getMenuBarPackDirection :: (MonadIO m, MenuBarK o) => o -> m PackDirection getMenuBarPackDirection obj = liftIO $ getObjectPropertyEnum obj "pack-direction" setMenuBarPackDirection :: (MonadIO m, MenuBarK o) => o -> PackDirection -> m () setMenuBarPackDirection obj val = liftIO $ setObjectPropertyEnum obj "pack-direction" val constructMenuBarPackDirection :: PackDirection -> IO ([Char], GValue) constructMenuBarPackDirection val = constructObjectPropertyEnum "pack-direction" val data MenuBarPackDirectionPropertyInfo instance AttrInfo MenuBarPackDirectionPropertyInfo where type AttrAllowedOps MenuBarPackDirectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuBarPackDirectionPropertyInfo = (~) PackDirection type AttrBaseTypeConstraint MenuBarPackDirectionPropertyInfo = MenuBarK type AttrGetType MenuBarPackDirectionPropertyInfo = PackDirection type AttrLabel MenuBarPackDirectionPropertyInfo = "MenuBar::pack-direction" attrGet _ = getMenuBarPackDirection attrSet _ = setMenuBarPackDirection attrConstruct _ = constructMenuBarPackDirection type instance AttributeList MenuBar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("child-pack-direction", MenuBarChildPackDirectionPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("pack-direction", MenuBarPackDirectionPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("take-focus", MenuShellTakeFocusPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "align-widget" -- Type: TInterface "Gtk" "Container" -- Flags: [PropertyReadable,PropertyWritable] getMenuButtonAlignWidget :: (MonadIO m, MenuButtonK o) => o -> m Container getMenuButtonAlignWidget obj = liftIO $ getObjectPropertyObject obj "align-widget" Container setMenuButtonAlignWidget :: (MonadIO m, MenuButtonK o, ContainerK a) => o -> a -> m () setMenuButtonAlignWidget obj val = liftIO $ setObjectPropertyObject obj "align-widget" val constructMenuButtonAlignWidget :: (ContainerK a) => a -> IO ([Char], GValue) constructMenuButtonAlignWidget val = constructObjectPropertyObject "align-widget" val data MenuButtonAlignWidgetPropertyInfo instance AttrInfo MenuButtonAlignWidgetPropertyInfo where type AttrAllowedOps MenuButtonAlignWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuButtonAlignWidgetPropertyInfo = ContainerK type AttrBaseTypeConstraint MenuButtonAlignWidgetPropertyInfo = MenuButtonK type AttrGetType MenuButtonAlignWidgetPropertyInfo = Container type AttrLabel MenuButtonAlignWidgetPropertyInfo = "MenuButton::align-widget" attrGet _ = getMenuButtonAlignWidget attrSet _ = setMenuButtonAlignWidget attrConstruct _ = constructMenuButtonAlignWidget -- VVV Prop "direction" -- Type: TInterface "Gtk" "ArrowType" -- Flags: [PropertyReadable,PropertyWritable] getMenuButtonDirection :: (MonadIO m, MenuButtonK o) => o -> m ArrowType getMenuButtonDirection obj = liftIO $ getObjectPropertyEnum obj "direction" setMenuButtonDirection :: (MonadIO m, MenuButtonK o) => o -> ArrowType -> m () setMenuButtonDirection obj val = liftIO $ setObjectPropertyEnum obj "direction" val constructMenuButtonDirection :: ArrowType -> IO ([Char], GValue) constructMenuButtonDirection val = constructObjectPropertyEnum "direction" val data MenuButtonDirectionPropertyInfo instance AttrInfo MenuButtonDirectionPropertyInfo where type AttrAllowedOps MenuButtonDirectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuButtonDirectionPropertyInfo = (~) ArrowType type AttrBaseTypeConstraint MenuButtonDirectionPropertyInfo = MenuButtonK type AttrGetType MenuButtonDirectionPropertyInfo = ArrowType type AttrLabel MenuButtonDirectionPropertyInfo = "MenuButton::direction" attrGet _ = getMenuButtonDirection attrSet _ = setMenuButtonDirection attrConstruct _ = constructMenuButtonDirection -- VVV Prop "menu-model" -- Type: TInterface "Gio" "MenuModel" -- Flags: [PropertyReadable,PropertyWritable] getMenuButtonMenuModel :: (MonadIO m, MenuButtonK o) => o -> m Gio.MenuModel getMenuButtonMenuModel obj = liftIO $ getObjectPropertyObject obj "menu-model" Gio.MenuModel setMenuButtonMenuModel :: (MonadIO m, MenuButtonK o, Gio.MenuModelK a) => o -> a -> m () setMenuButtonMenuModel obj val = liftIO $ setObjectPropertyObject obj "menu-model" val constructMenuButtonMenuModel :: (Gio.MenuModelK a) => a -> IO ([Char], GValue) constructMenuButtonMenuModel val = constructObjectPropertyObject "menu-model" val data MenuButtonMenuModelPropertyInfo instance AttrInfo MenuButtonMenuModelPropertyInfo where type AttrAllowedOps MenuButtonMenuModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuButtonMenuModelPropertyInfo = Gio.MenuModelK type AttrBaseTypeConstraint MenuButtonMenuModelPropertyInfo = MenuButtonK type AttrGetType MenuButtonMenuModelPropertyInfo = Gio.MenuModel type AttrLabel MenuButtonMenuModelPropertyInfo = "MenuButton::menu-model" attrGet _ = getMenuButtonMenuModel attrSet _ = setMenuButtonMenuModel attrConstruct _ = constructMenuButtonMenuModel -- VVV Prop "popover" -- Type: TInterface "Gtk" "Popover" -- Flags: [PropertyReadable,PropertyWritable] getMenuButtonPopover :: (MonadIO m, MenuButtonK o) => o -> m Popover getMenuButtonPopover obj = liftIO $ getObjectPropertyObject obj "popover" Popover setMenuButtonPopover :: (MonadIO m, MenuButtonK o, PopoverK a) => o -> a -> m () setMenuButtonPopover obj val = liftIO $ setObjectPropertyObject obj "popover" val constructMenuButtonPopover :: (PopoverK a) => a -> IO ([Char], GValue) constructMenuButtonPopover val = constructObjectPropertyObject "popover" val data MenuButtonPopoverPropertyInfo instance AttrInfo MenuButtonPopoverPropertyInfo where type AttrAllowedOps MenuButtonPopoverPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuButtonPopoverPropertyInfo = PopoverK type AttrBaseTypeConstraint MenuButtonPopoverPropertyInfo = MenuButtonK type AttrGetType MenuButtonPopoverPropertyInfo = Popover type AttrLabel MenuButtonPopoverPropertyInfo = "MenuButton::popover" attrGet _ = getMenuButtonPopover attrSet _ = setMenuButtonPopover attrConstruct _ = constructMenuButtonPopover -- VVV Prop "popup" -- Type: TInterface "Gtk" "Menu" -- Flags: [PropertyReadable,PropertyWritable] getMenuButtonPopup :: (MonadIO m, MenuButtonK o) => o -> m Menu getMenuButtonPopup obj = liftIO $ getObjectPropertyObject obj "popup" Menu setMenuButtonPopup :: (MonadIO m, MenuButtonK o, MenuK a) => o -> a -> m () setMenuButtonPopup obj val = liftIO $ setObjectPropertyObject obj "popup" val constructMenuButtonPopup :: (MenuK a) => a -> IO ([Char], GValue) constructMenuButtonPopup val = constructObjectPropertyObject "popup" val data MenuButtonPopupPropertyInfo instance AttrInfo MenuButtonPopupPropertyInfo where type AttrAllowedOps MenuButtonPopupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuButtonPopupPropertyInfo = MenuK type AttrBaseTypeConstraint MenuButtonPopupPropertyInfo = MenuButtonK type AttrGetType MenuButtonPopupPropertyInfo = Menu type AttrLabel MenuButtonPopupPropertyInfo = "MenuButton::popup" attrGet _ = getMenuButtonPopup attrSet _ = setMenuButtonPopup attrConstruct _ = constructMenuButtonPopup -- VVV Prop "use-popover" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getMenuButtonUsePopover :: (MonadIO m, MenuButtonK o) => o -> m Bool getMenuButtonUsePopover obj = liftIO $ getObjectPropertyBool obj "use-popover" setMenuButtonUsePopover :: (MonadIO m, MenuButtonK o) => o -> Bool -> m () setMenuButtonUsePopover obj val = liftIO $ setObjectPropertyBool obj "use-popover" val constructMenuButtonUsePopover :: Bool -> IO ([Char], GValue) constructMenuButtonUsePopover val = constructObjectPropertyBool "use-popover" val data MenuButtonUsePopoverPropertyInfo instance AttrInfo MenuButtonUsePopoverPropertyInfo where type AttrAllowedOps MenuButtonUsePopoverPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuButtonUsePopoverPropertyInfo = (~) Bool type AttrBaseTypeConstraint MenuButtonUsePopoverPropertyInfo = MenuButtonK type AttrGetType MenuButtonUsePopoverPropertyInfo = Bool type AttrLabel MenuButtonUsePopoverPropertyInfo = "MenuButton::use-popover" attrGet _ = getMenuButtonUsePopover attrSet _ = setMenuButtonUsePopover attrConstruct _ = constructMenuButtonUsePopover type instance AttributeList MenuButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("active", ToggleButtonActivePropertyInfo), '("align-widget", MenuButtonAlignWidgetPropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("direction", MenuButtonDirectionPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-indicator", ToggleButtonDrawIndicatorPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("inconsistent", ToggleButtonInconsistentPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("menu-model", MenuButtonMenuModelPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("popover", MenuButtonPopoverPropertyInfo), '("popup", MenuButtonPopupPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-popover", MenuButtonUsePopoverPropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] type instance AttributeList MenuButtonAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "accel-path" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMenuItemAccelPath :: (MonadIO m, MenuItemK o) => o -> m T.Text getMenuItemAccelPath obj = liftIO $ getObjectPropertyString obj "accel-path" setMenuItemAccelPath :: (MonadIO m, MenuItemK o) => o -> T.Text -> m () setMenuItemAccelPath obj val = liftIO $ setObjectPropertyString obj "accel-path" val constructMenuItemAccelPath :: T.Text -> IO ([Char], GValue) constructMenuItemAccelPath val = constructObjectPropertyString "accel-path" val data MenuItemAccelPathPropertyInfo instance AttrInfo MenuItemAccelPathPropertyInfo where type AttrAllowedOps MenuItemAccelPathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuItemAccelPathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint MenuItemAccelPathPropertyInfo = MenuItemK type AttrGetType MenuItemAccelPathPropertyInfo = T.Text type AttrLabel MenuItemAccelPathPropertyInfo = "MenuItem::accel-path" attrGet _ = getMenuItemAccelPath attrSet _ = setMenuItemAccelPath attrConstruct _ = constructMenuItemAccelPath -- VVV Prop "label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMenuItemLabel :: (MonadIO m, MenuItemK o) => o -> m T.Text getMenuItemLabel obj = liftIO $ getObjectPropertyString obj "label" setMenuItemLabel :: (MonadIO m, MenuItemK o) => o -> T.Text -> m () setMenuItemLabel obj val = liftIO $ setObjectPropertyString obj "label" val constructMenuItemLabel :: T.Text -> IO ([Char], GValue) constructMenuItemLabel val = constructObjectPropertyString "label" val data MenuItemLabelPropertyInfo instance AttrInfo MenuItemLabelPropertyInfo where type AttrAllowedOps MenuItemLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuItemLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint MenuItemLabelPropertyInfo = MenuItemK type AttrGetType MenuItemLabelPropertyInfo = T.Text type AttrLabel MenuItemLabelPropertyInfo = "MenuItem::label" attrGet _ = getMenuItemLabel attrSet _ = setMenuItemLabel attrConstruct _ = constructMenuItemLabel -- VVV Prop "right-justified" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getMenuItemRightJustified :: (MonadIO m, MenuItemK o) => o -> m Bool getMenuItemRightJustified obj = liftIO $ getObjectPropertyBool obj "right-justified" setMenuItemRightJustified :: (MonadIO m, MenuItemK o) => o -> Bool -> m () setMenuItemRightJustified obj val = liftIO $ setObjectPropertyBool obj "right-justified" val constructMenuItemRightJustified :: Bool -> IO ([Char], GValue) constructMenuItemRightJustified val = constructObjectPropertyBool "right-justified" val data MenuItemRightJustifiedPropertyInfo instance AttrInfo MenuItemRightJustifiedPropertyInfo where type AttrAllowedOps MenuItemRightJustifiedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuItemRightJustifiedPropertyInfo = (~) Bool type AttrBaseTypeConstraint MenuItemRightJustifiedPropertyInfo = MenuItemK type AttrGetType MenuItemRightJustifiedPropertyInfo = Bool type AttrLabel MenuItemRightJustifiedPropertyInfo = "MenuItem::right-justified" attrGet _ = getMenuItemRightJustified attrSet _ = setMenuItemRightJustified attrConstruct _ = constructMenuItemRightJustified -- VVV Prop "submenu" -- Type: TInterface "Gtk" "Menu" -- Flags: [PropertyReadable,PropertyWritable] getMenuItemSubmenu :: (MonadIO m, MenuItemK o) => o -> m Menu getMenuItemSubmenu obj = liftIO $ getObjectPropertyObject obj "submenu" Menu setMenuItemSubmenu :: (MonadIO m, MenuItemK o, MenuK a) => o -> a -> m () setMenuItemSubmenu obj val = liftIO $ setObjectPropertyObject obj "submenu" val constructMenuItemSubmenu :: (MenuK a) => a -> IO ([Char], GValue) constructMenuItemSubmenu val = constructObjectPropertyObject "submenu" val data MenuItemSubmenuPropertyInfo instance AttrInfo MenuItemSubmenuPropertyInfo where type AttrAllowedOps MenuItemSubmenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuItemSubmenuPropertyInfo = MenuK type AttrBaseTypeConstraint MenuItemSubmenuPropertyInfo = MenuItemK type AttrGetType MenuItemSubmenuPropertyInfo = Menu type AttrLabel MenuItemSubmenuPropertyInfo = "MenuItem::submenu" attrGet _ = getMenuItemSubmenu attrSet _ = setMenuItemSubmenu attrConstruct _ = constructMenuItemSubmenu -- VVV Prop "use-underline" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getMenuItemUseUnderline :: (MonadIO m, MenuItemK o) => o -> m Bool getMenuItemUseUnderline obj = liftIO $ getObjectPropertyBool obj "use-underline" setMenuItemUseUnderline :: (MonadIO m, MenuItemK o) => o -> Bool -> m () setMenuItemUseUnderline obj val = liftIO $ setObjectPropertyBool obj "use-underline" val constructMenuItemUseUnderline :: Bool -> IO ([Char], GValue) constructMenuItemUseUnderline val = constructObjectPropertyBool "use-underline" val data MenuItemUseUnderlinePropertyInfo instance AttrInfo MenuItemUseUnderlinePropertyInfo where type AttrAllowedOps MenuItemUseUnderlinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuItemUseUnderlinePropertyInfo = (~) Bool type AttrBaseTypeConstraint MenuItemUseUnderlinePropertyInfo = MenuItemK type AttrGetType MenuItemUseUnderlinePropertyInfo = Bool type AttrLabel MenuItemUseUnderlinePropertyInfo = "MenuItem::use-underline" attrGet _ = getMenuItemUseUnderline attrSet _ = setMenuItemUseUnderline attrConstruct _ = constructMenuItemUseUnderline type instance AttributeList MenuItem = '[ '("accel-path", MenuItemAccelPathPropertyInfo), '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", MenuItemLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("right-justified", MenuItemRightJustifiedPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("submenu", MenuItemSubmenuPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-underline", MenuItemUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList MenuItemAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "take-focus" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getMenuShellTakeFocus :: (MonadIO m, MenuShellK o) => o -> m Bool getMenuShellTakeFocus obj = liftIO $ getObjectPropertyBool obj "take-focus" setMenuShellTakeFocus :: (MonadIO m, MenuShellK o) => o -> Bool -> m () setMenuShellTakeFocus obj val = liftIO $ setObjectPropertyBool obj "take-focus" val constructMenuShellTakeFocus :: Bool -> IO ([Char], GValue) constructMenuShellTakeFocus val = constructObjectPropertyBool "take-focus" val data MenuShellTakeFocusPropertyInfo instance AttrInfo MenuShellTakeFocusPropertyInfo where type AttrAllowedOps MenuShellTakeFocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuShellTakeFocusPropertyInfo = (~) Bool type AttrBaseTypeConstraint MenuShellTakeFocusPropertyInfo = MenuShellK type AttrGetType MenuShellTakeFocusPropertyInfo = Bool type AttrLabel MenuShellTakeFocusPropertyInfo = "MenuShell::take-focus" attrGet _ = getMenuShellTakeFocus attrSet _ = setMenuShellTakeFocus attrConstruct _ = constructMenuShellTakeFocus type instance AttributeList MenuShell = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("take-focus", MenuShellTakeFocusPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList MenuShellAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "menu" -- Type: TInterface "Gtk" "Menu" -- Flags: [PropertyReadable,PropertyWritable] getMenuToolButtonMenu :: (MonadIO m, MenuToolButtonK o) => o -> m Menu getMenuToolButtonMenu obj = liftIO $ getObjectPropertyObject obj "menu" Menu setMenuToolButtonMenu :: (MonadIO m, MenuToolButtonK o, MenuK a) => o -> a -> m () setMenuToolButtonMenu obj val = liftIO $ setObjectPropertyObject obj "menu" val constructMenuToolButtonMenu :: (MenuK a) => a -> IO ([Char], GValue) constructMenuToolButtonMenu val = constructObjectPropertyObject "menu" val data MenuToolButtonMenuPropertyInfo instance AttrInfo MenuToolButtonMenuPropertyInfo where type AttrAllowedOps MenuToolButtonMenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MenuToolButtonMenuPropertyInfo = MenuK type AttrBaseTypeConstraint MenuToolButtonMenuPropertyInfo = MenuToolButtonK type AttrGetType MenuToolButtonMenuPropertyInfo = Menu type AttrLabel MenuToolButtonMenuPropertyInfo = "MenuToolButton::menu" attrGet _ = getMenuToolButtonMenu attrSet _ = setMenuToolButtonMenu attrConstruct _ = constructMenuToolButtonMenu type instance AttributeList MenuToolButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("icon-name", ToolButtonIconNamePropertyInfo), '("icon-widget", ToolButtonIconWidgetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-important", ToolItemIsImportantPropertyInfo), '("label", ToolButtonLabelPropertyInfo), '("label-widget", ToolButtonLabelWidgetPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("menu", MenuToolButtonMenuPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("stock-id", ToolButtonStockIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-underline", ToolButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("visible-horizontal", ToolItemVisibleHorizontalPropertyInfo), '("visible-vertical", ToolItemVisibleVerticalPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "buttons" -- Type: TInterface "Gtk" "ButtonsType" -- Flags: [PropertyWritable,PropertyConstructOnly] constructMessageDialogButtons :: ButtonsType -> IO ([Char], GValue) constructMessageDialogButtons val = constructObjectPropertyEnum "buttons" val data MessageDialogButtonsPropertyInfo instance AttrInfo MessageDialogButtonsPropertyInfo where type AttrAllowedOps MessageDialogButtonsPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint MessageDialogButtonsPropertyInfo = (~) ButtonsType type AttrBaseTypeConstraint MessageDialogButtonsPropertyInfo = MessageDialogK type AttrGetType MessageDialogButtonsPropertyInfo = () type AttrLabel MessageDialogButtonsPropertyInfo = "MessageDialog::buttons" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructMessageDialogButtons -- VVV Prop "image" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getMessageDialogImage :: (MonadIO m, MessageDialogK o) => o -> m Widget getMessageDialogImage obj = liftIO $ getObjectPropertyObject obj "image" Widget setMessageDialogImage :: (MonadIO m, MessageDialogK o, WidgetK a) => o -> a -> m () setMessageDialogImage obj val = liftIO $ setObjectPropertyObject obj "image" val constructMessageDialogImage :: (WidgetK a) => a -> IO ([Char], GValue) constructMessageDialogImage val = constructObjectPropertyObject "image" val data MessageDialogImagePropertyInfo instance AttrInfo MessageDialogImagePropertyInfo where type AttrAllowedOps MessageDialogImagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageDialogImagePropertyInfo = WidgetK type AttrBaseTypeConstraint MessageDialogImagePropertyInfo = MessageDialogK type AttrGetType MessageDialogImagePropertyInfo = Widget type AttrLabel MessageDialogImagePropertyInfo = "MessageDialog::image" attrGet _ = getMessageDialogImage attrSet _ = setMessageDialogImage attrConstruct _ = constructMessageDialogImage -- VVV Prop "message-area" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable] getMessageDialogMessageArea :: (MonadIO m, MessageDialogK o) => o -> m Widget getMessageDialogMessageArea obj = liftIO $ getObjectPropertyObject obj "message-area" Widget data MessageDialogMessageAreaPropertyInfo instance AttrInfo MessageDialogMessageAreaPropertyInfo where type AttrAllowedOps MessageDialogMessageAreaPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint MessageDialogMessageAreaPropertyInfo = (~) () type AttrBaseTypeConstraint MessageDialogMessageAreaPropertyInfo = MessageDialogK type AttrGetType MessageDialogMessageAreaPropertyInfo = Widget type AttrLabel MessageDialogMessageAreaPropertyInfo = "MessageDialog::message-area" attrGet _ = getMessageDialogMessageArea attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "message-type" -- Type: TInterface "Gtk" "MessageType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getMessageDialogMessageType :: (MonadIO m, MessageDialogK o) => o -> m MessageType getMessageDialogMessageType obj = liftIO $ getObjectPropertyEnum obj "message-type" setMessageDialogMessageType :: (MonadIO m, MessageDialogK o) => o -> MessageType -> m () setMessageDialogMessageType obj val = liftIO $ setObjectPropertyEnum obj "message-type" val constructMessageDialogMessageType :: MessageType -> IO ([Char], GValue) constructMessageDialogMessageType val = constructObjectPropertyEnum "message-type" val data MessageDialogMessageTypePropertyInfo instance AttrInfo MessageDialogMessageTypePropertyInfo where type AttrAllowedOps MessageDialogMessageTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageDialogMessageTypePropertyInfo = (~) MessageType type AttrBaseTypeConstraint MessageDialogMessageTypePropertyInfo = MessageDialogK type AttrGetType MessageDialogMessageTypePropertyInfo = MessageType type AttrLabel MessageDialogMessageTypePropertyInfo = "MessageDialog::message-type" attrGet _ = getMessageDialogMessageType attrSet _ = setMessageDialogMessageType attrConstruct _ = constructMessageDialogMessageType -- VVV Prop "secondary-text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMessageDialogSecondaryText :: (MonadIO m, MessageDialogK o) => o -> m T.Text getMessageDialogSecondaryText obj = liftIO $ getObjectPropertyString obj "secondary-text" setMessageDialogSecondaryText :: (MonadIO m, MessageDialogK o) => o -> T.Text -> m () setMessageDialogSecondaryText obj val = liftIO $ setObjectPropertyString obj "secondary-text" val constructMessageDialogSecondaryText :: T.Text -> IO ([Char], GValue) constructMessageDialogSecondaryText val = constructObjectPropertyString "secondary-text" val data MessageDialogSecondaryTextPropertyInfo instance AttrInfo MessageDialogSecondaryTextPropertyInfo where type AttrAllowedOps MessageDialogSecondaryTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageDialogSecondaryTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint MessageDialogSecondaryTextPropertyInfo = MessageDialogK type AttrGetType MessageDialogSecondaryTextPropertyInfo = T.Text type AttrLabel MessageDialogSecondaryTextPropertyInfo = "MessageDialog::secondary-text" attrGet _ = getMessageDialogSecondaryText attrSet _ = setMessageDialogSecondaryText attrConstruct _ = constructMessageDialogSecondaryText -- VVV Prop "secondary-use-markup" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getMessageDialogSecondaryUseMarkup :: (MonadIO m, MessageDialogK o) => o -> m Bool getMessageDialogSecondaryUseMarkup obj = liftIO $ getObjectPropertyBool obj "secondary-use-markup" setMessageDialogSecondaryUseMarkup :: (MonadIO m, MessageDialogK o) => o -> Bool -> m () setMessageDialogSecondaryUseMarkup obj val = liftIO $ setObjectPropertyBool obj "secondary-use-markup" val constructMessageDialogSecondaryUseMarkup :: Bool -> IO ([Char], GValue) constructMessageDialogSecondaryUseMarkup val = constructObjectPropertyBool "secondary-use-markup" val data MessageDialogSecondaryUseMarkupPropertyInfo instance AttrInfo MessageDialogSecondaryUseMarkupPropertyInfo where type AttrAllowedOps MessageDialogSecondaryUseMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageDialogSecondaryUseMarkupPropertyInfo = (~) Bool type AttrBaseTypeConstraint MessageDialogSecondaryUseMarkupPropertyInfo = MessageDialogK type AttrGetType MessageDialogSecondaryUseMarkupPropertyInfo = Bool type AttrLabel MessageDialogSecondaryUseMarkupPropertyInfo = "MessageDialog::secondary-use-markup" attrGet _ = getMessageDialogSecondaryUseMarkup attrSet _ = setMessageDialogSecondaryUseMarkup attrConstruct _ = constructMessageDialogSecondaryUseMarkup -- VVV Prop "text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMessageDialogText :: (MonadIO m, MessageDialogK o) => o -> m T.Text getMessageDialogText obj = liftIO $ getObjectPropertyString obj "text" setMessageDialogText :: (MonadIO m, MessageDialogK o) => o -> T.Text -> m () setMessageDialogText obj val = liftIO $ setObjectPropertyString obj "text" val constructMessageDialogText :: T.Text -> IO ([Char], GValue) constructMessageDialogText val = constructObjectPropertyString "text" val data MessageDialogTextPropertyInfo instance AttrInfo MessageDialogTextPropertyInfo where type AttrAllowedOps MessageDialogTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageDialogTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint MessageDialogTextPropertyInfo = MessageDialogK type AttrGetType MessageDialogTextPropertyInfo = T.Text type AttrLabel MessageDialogTextPropertyInfo = "MessageDialog::text" attrGet _ = getMessageDialogText attrSet _ = setMessageDialogText attrConstruct _ = constructMessageDialogText -- VVV Prop "use-markup" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getMessageDialogUseMarkup :: (MonadIO m, MessageDialogK o) => o -> m Bool getMessageDialogUseMarkup obj = liftIO $ getObjectPropertyBool obj "use-markup" setMessageDialogUseMarkup :: (MonadIO m, MessageDialogK o) => o -> Bool -> m () setMessageDialogUseMarkup obj val = liftIO $ setObjectPropertyBool obj "use-markup" val constructMessageDialogUseMarkup :: Bool -> IO ([Char], GValue) constructMessageDialogUseMarkup val = constructObjectPropertyBool "use-markup" val data MessageDialogUseMarkupPropertyInfo instance AttrInfo MessageDialogUseMarkupPropertyInfo where type AttrAllowedOps MessageDialogUseMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageDialogUseMarkupPropertyInfo = (~) Bool type AttrBaseTypeConstraint MessageDialogUseMarkupPropertyInfo = MessageDialogK type AttrGetType MessageDialogUseMarkupPropertyInfo = Bool type AttrLabel MessageDialogUseMarkupPropertyInfo = "MessageDialog::use-markup" attrGet _ = getMessageDialogUseMarkup attrSet _ = setMessageDialogUseMarkup attrConstruct _ = constructMessageDialogUseMarkup type instance AttributeList MessageDialog = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("buttons", MessageDialogButtonsPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("image", MessageDialogImagePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("message-area", MessageDialogMessageAreaPropertyInfo), '("message-type", MessageDialogMessageTypePropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("secondary-text", MessageDialogSecondaryTextPropertyInfo), '("secondary-use-markup", MessageDialogSecondaryUseMarkupPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("text", MessageDialogTextPropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-header-bar", DialogUseHeaderBarPropertyInfo), '("use-markup", MessageDialogUseMarkupPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] -- VVV Prop "xalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getMiscXalign :: (MonadIO m, MiscK o) => o -> m Float getMiscXalign obj = liftIO $ getObjectPropertyFloat obj "xalign" setMiscXalign :: (MonadIO m, MiscK o) => o -> Float -> m () setMiscXalign obj val = liftIO $ setObjectPropertyFloat obj "xalign" val constructMiscXalign :: Float -> IO ([Char], GValue) constructMiscXalign val = constructObjectPropertyFloat "xalign" val data MiscXalignPropertyInfo instance AttrInfo MiscXalignPropertyInfo where type AttrAllowedOps MiscXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MiscXalignPropertyInfo = (~) Float type AttrBaseTypeConstraint MiscXalignPropertyInfo = MiscK type AttrGetType MiscXalignPropertyInfo = Float type AttrLabel MiscXalignPropertyInfo = "Misc::xalign" attrGet _ = getMiscXalign attrSet _ = setMiscXalign attrConstruct _ = constructMiscXalign -- VVV Prop "xpad" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getMiscXpad :: (MonadIO m, MiscK o) => o -> m Int32 getMiscXpad obj = liftIO $ getObjectPropertyCInt obj "xpad" setMiscXpad :: (MonadIO m, MiscK o) => o -> Int32 -> m () setMiscXpad obj val = liftIO $ setObjectPropertyCInt obj "xpad" val constructMiscXpad :: Int32 -> IO ([Char], GValue) constructMiscXpad val = constructObjectPropertyCInt "xpad" val data MiscXpadPropertyInfo instance AttrInfo MiscXpadPropertyInfo where type AttrAllowedOps MiscXpadPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MiscXpadPropertyInfo = (~) Int32 type AttrBaseTypeConstraint MiscXpadPropertyInfo = MiscK type AttrGetType MiscXpadPropertyInfo = Int32 type AttrLabel MiscXpadPropertyInfo = "Misc::xpad" attrGet _ = getMiscXpad attrSet _ = setMiscXpad attrConstruct _ = constructMiscXpad -- VVV Prop "yalign" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getMiscYalign :: (MonadIO m, MiscK o) => o -> m Float getMiscYalign obj = liftIO $ getObjectPropertyFloat obj "yalign" setMiscYalign :: (MonadIO m, MiscK o) => o -> Float -> m () setMiscYalign obj val = liftIO $ setObjectPropertyFloat obj "yalign" val constructMiscYalign :: Float -> IO ([Char], GValue) constructMiscYalign val = constructObjectPropertyFloat "yalign" val data MiscYalignPropertyInfo instance AttrInfo MiscYalignPropertyInfo where type AttrAllowedOps MiscYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MiscYalignPropertyInfo = (~) Float type AttrBaseTypeConstraint MiscYalignPropertyInfo = MiscK type AttrGetType MiscYalignPropertyInfo = Float type AttrLabel MiscYalignPropertyInfo = "Misc::yalign" attrGet _ = getMiscYalign attrSet _ = setMiscYalign attrConstruct _ = constructMiscYalign -- VVV Prop "ypad" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getMiscYpad :: (MonadIO m, MiscK o) => o -> m Int32 getMiscYpad obj = liftIO $ getObjectPropertyCInt obj "ypad" setMiscYpad :: (MonadIO m, MiscK o) => o -> Int32 -> m () setMiscYpad obj val = liftIO $ setObjectPropertyCInt obj "ypad" val constructMiscYpad :: Int32 -> IO ([Char], GValue) constructMiscYpad val = constructObjectPropertyCInt "ypad" val data MiscYpadPropertyInfo instance AttrInfo MiscYpadPropertyInfo where type AttrAllowedOps MiscYpadPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MiscYpadPropertyInfo = (~) Int32 type AttrBaseTypeConstraint MiscYpadPropertyInfo = MiscK type AttrGetType MiscYpadPropertyInfo = Int32 type AttrLabel MiscYpadPropertyInfo = "Misc::ypad" attrGet _ = getMiscYpad attrSet _ = setMiscYpad attrConstruct _ = constructMiscYpad type instance AttributeList Misc = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", MiscXalignPropertyInfo), '("xpad", MiscXpadPropertyInfo), '("yalign", MiscYalignPropertyInfo), '("ypad", MiscYpadPropertyInfo)] -- VVV Prop "active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getModelButtonActive :: (MonadIO m, ModelButtonK o) => o -> m Bool getModelButtonActive obj = liftIO $ getObjectPropertyBool obj "active" setModelButtonActive :: (MonadIO m, ModelButtonK o) => o -> Bool -> m () setModelButtonActive obj val = liftIO $ setObjectPropertyBool obj "active" val constructModelButtonActive :: Bool -> IO ([Char], GValue) constructModelButtonActive val = constructObjectPropertyBool "active" val data ModelButtonActivePropertyInfo instance AttrInfo ModelButtonActivePropertyInfo where type AttrAllowedOps ModelButtonActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ModelButtonActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint ModelButtonActivePropertyInfo = ModelButtonK type AttrGetType ModelButtonActivePropertyInfo = Bool type AttrLabel ModelButtonActivePropertyInfo = "ModelButton::active" attrGet _ = getModelButtonActive attrSet _ = setModelButtonActive attrConstruct _ = constructModelButtonActive -- VVV Prop "centered" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getModelButtonCentered :: (MonadIO m, ModelButtonK o) => o -> m Bool getModelButtonCentered obj = liftIO $ getObjectPropertyBool obj "centered" setModelButtonCentered :: (MonadIO m, ModelButtonK o) => o -> Bool -> m () setModelButtonCentered obj val = liftIO $ setObjectPropertyBool obj "centered" val constructModelButtonCentered :: Bool -> IO ([Char], GValue) constructModelButtonCentered val = constructObjectPropertyBool "centered" val data ModelButtonCenteredPropertyInfo instance AttrInfo ModelButtonCenteredPropertyInfo where type AttrAllowedOps ModelButtonCenteredPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ModelButtonCenteredPropertyInfo = (~) Bool type AttrBaseTypeConstraint ModelButtonCenteredPropertyInfo = ModelButtonK type AttrGetType ModelButtonCenteredPropertyInfo = Bool type AttrLabel ModelButtonCenteredPropertyInfo = "ModelButton::centered" attrGet _ = getModelButtonCentered attrSet _ = setModelButtonCentered attrConstruct _ = constructModelButtonCentered -- VVV Prop "icon" -- Type: TInterface "Gio" "Icon" -- Flags: [PropertyReadable,PropertyWritable] getModelButtonIcon :: (MonadIO m, ModelButtonK o) => o -> m Gio.Icon getModelButtonIcon obj = liftIO $ getObjectPropertyObject obj "icon" Gio.Icon setModelButtonIcon :: (MonadIO m, ModelButtonK o, Gio.IconK a) => o -> a -> m () setModelButtonIcon obj val = liftIO $ setObjectPropertyObject obj "icon" val constructModelButtonIcon :: (Gio.IconK a) => a -> IO ([Char], GValue) constructModelButtonIcon val = constructObjectPropertyObject "icon" val data ModelButtonIconPropertyInfo instance AttrInfo ModelButtonIconPropertyInfo where type AttrAllowedOps ModelButtonIconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ModelButtonIconPropertyInfo = Gio.IconK type AttrBaseTypeConstraint ModelButtonIconPropertyInfo = ModelButtonK type AttrGetType ModelButtonIconPropertyInfo = Gio.Icon type AttrLabel ModelButtonIconPropertyInfo = "ModelButton::icon" attrGet _ = getModelButtonIcon attrSet _ = setModelButtonIcon attrConstruct _ = constructModelButtonIcon -- VVV Prop "iconic" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getModelButtonIconic :: (MonadIO m, ModelButtonK o) => o -> m Bool getModelButtonIconic obj = liftIO $ getObjectPropertyBool obj "iconic" setModelButtonIconic :: (MonadIO m, ModelButtonK o) => o -> Bool -> m () setModelButtonIconic obj val = liftIO $ setObjectPropertyBool obj "iconic" val constructModelButtonIconic :: Bool -> IO ([Char], GValue) constructModelButtonIconic val = constructObjectPropertyBool "iconic" val data ModelButtonIconicPropertyInfo instance AttrInfo ModelButtonIconicPropertyInfo where type AttrAllowedOps ModelButtonIconicPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ModelButtonIconicPropertyInfo = (~) Bool type AttrBaseTypeConstraint ModelButtonIconicPropertyInfo = ModelButtonK type AttrGetType ModelButtonIconicPropertyInfo = Bool type AttrLabel ModelButtonIconicPropertyInfo = "ModelButton::iconic" attrGet _ = getModelButtonIconic attrSet _ = setModelButtonIconic attrConstruct _ = constructModelButtonIconic -- VVV Prop "inverted" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getModelButtonInverted :: (MonadIO m, ModelButtonK o) => o -> m Bool getModelButtonInverted obj = liftIO $ getObjectPropertyBool obj "inverted" setModelButtonInverted :: (MonadIO m, ModelButtonK o) => o -> Bool -> m () setModelButtonInverted obj val = liftIO $ setObjectPropertyBool obj "inverted" val constructModelButtonInverted :: Bool -> IO ([Char], GValue) constructModelButtonInverted val = constructObjectPropertyBool "inverted" val data ModelButtonInvertedPropertyInfo instance AttrInfo ModelButtonInvertedPropertyInfo where type AttrAllowedOps ModelButtonInvertedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ModelButtonInvertedPropertyInfo = (~) Bool type AttrBaseTypeConstraint ModelButtonInvertedPropertyInfo = ModelButtonK type AttrGetType ModelButtonInvertedPropertyInfo = Bool type AttrLabel ModelButtonInvertedPropertyInfo = "ModelButton::inverted" attrGet _ = getModelButtonInverted attrSet _ = setModelButtonInverted attrConstruct _ = constructModelButtonInverted -- VVV Prop "menu-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getModelButtonMenuName :: (MonadIO m, ModelButtonK o) => o -> m T.Text getModelButtonMenuName obj = liftIO $ getObjectPropertyString obj "menu-name" setModelButtonMenuName :: (MonadIO m, ModelButtonK o) => o -> T.Text -> m () setModelButtonMenuName obj val = liftIO $ setObjectPropertyString obj "menu-name" val constructModelButtonMenuName :: T.Text -> IO ([Char], GValue) constructModelButtonMenuName val = constructObjectPropertyString "menu-name" val data ModelButtonMenuNamePropertyInfo instance AttrInfo ModelButtonMenuNamePropertyInfo where type AttrAllowedOps ModelButtonMenuNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ModelButtonMenuNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ModelButtonMenuNamePropertyInfo = ModelButtonK type AttrGetType ModelButtonMenuNamePropertyInfo = T.Text type AttrLabel ModelButtonMenuNamePropertyInfo = "ModelButton::menu-name" attrGet _ = getModelButtonMenuName attrSet _ = setModelButtonMenuName attrConstruct _ = constructModelButtonMenuName -- VVV Prop "role" -- Type: TInterface "Gtk" "ButtonRole" -- Flags: [PropertyReadable,PropertyWritable] getModelButtonRole :: (MonadIO m, ModelButtonK o) => o -> m ButtonRole getModelButtonRole obj = liftIO $ getObjectPropertyEnum obj "role" setModelButtonRole :: (MonadIO m, ModelButtonK o) => o -> ButtonRole -> m () setModelButtonRole obj val = liftIO $ setObjectPropertyEnum obj "role" val constructModelButtonRole :: ButtonRole -> IO ([Char], GValue) constructModelButtonRole val = constructObjectPropertyEnum "role" val data ModelButtonRolePropertyInfo instance AttrInfo ModelButtonRolePropertyInfo where type AttrAllowedOps ModelButtonRolePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ModelButtonRolePropertyInfo = (~) ButtonRole type AttrBaseTypeConstraint ModelButtonRolePropertyInfo = ModelButtonK type AttrGetType ModelButtonRolePropertyInfo = ButtonRole type AttrLabel ModelButtonRolePropertyInfo = "ModelButton::role" attrGet _ = getModelButtonRole attrSet _ = setModelButtonRole attrConstruct _ = constructModelButtonRole -- VVV Prop "text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getModelButtonText :: (MonadIO m, ModelButtonK o) => o -> m T.Text getModelButtonText obj = liftIO $ getObjectPropertyString obj "text" setModelButtonText :: (MonadIO m, ModelButtonK o) => o -> T.Text -> m () setModelButtonText obj val = liftIO $ setObjectPropertyString obj "text" val constructModelButtonText :: T.Text -> IO ([Char], GValue) constructModelButtonText val = constructObjectPropertyString "text" val data ModelButtonTextPropertyInfo instance AttrInfo ModelButtonTextPropertyInfo where type AttrAllowedOps ModelButtonTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ModelButtonTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ModelButtonTextPropertyInfo = ModelButtonK type AttrGetType ModelButtonTextPropertyInfo = T.Text type AttrLabel ModelButtonTextPropertyInfo = "ModelButton::text" attrGet _ = getModelButtonText attrSet _ = setModelButtonText attrConstruct _ = constructModelButtonText type instance AttributeList ModelButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("active", ModelButtonActivePropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("centered", ModelButtonCenteredPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("icon", ModelButtonIconPropertyInfo), '("iconic", ModelButtonIconicPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("inverted", ModelButtonInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("menu-name", ModelButtonMenuNamePropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", ModelButtonRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("text", ModelButtonTextPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] -- VVV Prop "is-showing" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getMountOperationIsShowing :: (MonadIO m, MountOperationK o) => o -> m Bool getMountOperationIsShowing obj = liftIO $ getObjectPropertyBool obj "is-showing" data MountOperationIsShowingPropertyInfo instance AttrInfo MountOperationIsShowingPropertyInfo where type AttrAllowedOps MountOperationIsShowingPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint MountOperationIsShowingPropertyInfo = (~) () type AttrBaseTypeConstraint MountOperationIsShowingPropertyInfo = MountOperationK type AttrGetType MountOperationIsShowingPropertyInfo = Bool type AttrLabel MountOperationIsShowingPropertyInfo = "MountOperation::is-showing" attrGet _ = getMountOperationIsShowing attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "parent" -- Type: TInterface "Gtk" "Window" -- Flags: [PropertyReadable,PropertyWritable] getMountOperationParent :: (MonadIO m, MountOperationK o) => o -> m Window getMountOperationParent obj = liftIO $ getObjectPropertyObject obj "parent" Window setMountOperationParent :: (MonadIO m, MountOperationK o, WindowK a) => o -> a -> m () setMountOperationParent obj val = liftIO $ setObjectPropertyObject obj "parent" val constructMountOperationParent :: (WindowK a) => a -> IO ([Char], GValue) constructMountOperationParent val = constructObjectPropertyObject "parent" val data MountOperationParentPropertyInfo instance AttrInfo MountOperationParentPropertyInfo where type AttrAllowedOps MountOperationParentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MountOperationParentPropertyInfo = WindowK type AttrBaseTypeConstraint MountOperationParentPropertyInfo = MountOperationK type AttrGetType MountOperationParentPropertyInfo = Window type AttrLabel MountOperationParentPropertyInfo = "MountOperation::parent" attrGet _ = getMountOperationParent attrSet _ = setMountOperationParent attrConstruct _ = constructMountOperationParent -- VVV Prop "screen" -- Type: TInterface "Gdk" "Screen" -- Flags: [PropertyReadable,PropertyWritable] getMountOperationScreen :: (MonadIO m, MountOperationK o) => o -> m Gdk.Screen getMountOperationScreen obj = liftIO $ getObjectPropertyObject obj "screen" Gdk.Screen setMountOperationScreen :: (MonadIO m, MountOperationK o, Gdk.ScreenK a) => o -> a -> m () setMountOperationScreen obj val = liftIO $ setObjectPropertyObject obj "screen" val constructMountOperationScreen :: (Gdk.ScreenK a) => a -> IO ([Char], GValue) constructMountOperationScreen val = constructObjectPropertyObject "screen" val data MountOperationScreenPropertyInfo instance AttrInfo MountOperationScreenPropertyInfo where type AttrAllowedOps MountOperationScreenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MountOperationScreenPropertyInfo = Gdk.ScreenK type AttrBaseTypeConstraint MountOperationScreenPropertyInfo = MountOperationK type AttrGetType MountOperationScreenPropertyInfo = Gdk.Screen type AttrLabel MountOperationScreenPropertyInfo = "MountOperation::screen" attrGet _ = getMountOperationScreen attrSet _ = setMountOperationScreen attrConstruct _ = constructMountOperationScreen type instance AttributeList MountOperation = '[ '("anonymous", GioA.MountOperationAnonymousPropertyInfo), '("choice", GioA.MountOperationChoicePropertyInfo), '("domain", GioA.MountOperationDomainPropertyInfo), '("is-showing", MountOperationIsShowingPropertyInfo), '("parent", MountOperationParentPropertyInfo), '("password", GioA.MountOperationPasswordPropertyInfo), '("password-save", GioA.MountOperationPasswordSavePropertyInfo), '("screen", MountOperationScreenPropertyInfo), '("username", GioA.MountOperationUsernamePropertyInfo)] -- VVV Prop "enable-popup" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getNotebookEnablePopup :: (MonadIO m, NotebookK o) => o -> m Bool getNotebookEnablePopup obj = liftIO $ getObjectPropertyBool obj "enable-popup" setNotebookEnablePopup :: (MonadIO m, NotebookK o) => o -> Bool -> m () setNotebookEnablePopup obj val = liftIO $ setObjectPropertyBool obj "enable-popup" val constructNotebookEnablePopup :: Bool -> IO ([Char], GValue) constructNotebookEnablePopup val = constructObjectPropertyBool "enable-popup" val data NotebookEnablePopupPropertyInfo instance AttrInfo NotebookEnablePopupPropertyInfo where type AttrAllowedOps NotebookEnablePopupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookEnablePopupPropertyInfo = (~) Bool type AttrBaseTypeConstraint NotebookEnablePopupPropertyInfo = NotebookK type AttrGetType NotebookEnablePopupPropertyInfo = Bool type AttrLabel NotebookEnablePopupPropertyInfo = "Notebook::enable-popup" attrGet _ = getNotebookEnablePopup attrSet _ = setNotebookEnablePopup attrConstruct _ = constructNotebookEnablePopup -- VVV Prop "group-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getNotebookGroupName :: (MonadIO m, NotebookK o) => o -> m T.Text getNotebookGroupName obj = liftIO $ getObjectPropertyString obj "group-name" setNotebookGroupName :: (MonadIO m, NotebookK o) => o -> T.Text -> m () setNotebookGroupName obj val = liftIO $ setObjectPropertyString obj "group-name" val constructNotebookGroupName :: T.Text -> IO ([Char], GValue) constructNotebookGroupName val = constructObjectPropertyString "group-name" val data NotebookGroupNamePropertyInfo instance AttrInfo NotebookGroupNamePropertyInfo where type AttrAllowedOps NotebookGroupNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookGroupNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint NotebookGroupNamePropertyInfo = NotebookK type AttrGetType NotebookGroupNamePropertyInfo = T.Text type AttrLabel NotebookGroupNamePropertyInfo = "Notebook::group-name" attrGet _ = getNotebookGroupName attrSet _ = setNotebookGroupName attrConstruct _ = constructNotebookGroupName -- VVV Prop "page" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getNotebookPage :: (MonadIO m, NotebookK o) => o -> m Int32 getNotebookPage obj = liftIO $ getObjectPropertyCInt obj "page" setNotebookPage :: (MonadIO m, NotebookK o) => o -> Int32 -> m () setNotebookPage obj val = liftIO $ setObjectPropertyCInt obj "page" val constructNotebookPage :: Int32 -> IO ([Char], GValue) constructNotebookPage val = constructObjectPropertyCInt "page" val data NotebookPagePropertyInfo instance AttrInfo NotebookPagePropertyInfo where type AttrAllowedOps NotebookPagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookPagePropertyInfo = (~) Int32 type AttrBaseTypeConstraint NotebookPagePropertyInfo = NotebookK type AttrGetType NotebookPagePropertyInfo = Int32 type AttrLabel NotebookPagePropertyInfo = "Notebook::page" attrGet _ = getNotebookPage attrSet _ = setNotebookPage attrConstruct _ = constructNotebookPage -- VVV Prop "scrollable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getNotebookScrollable :: (MonadIO m, NotebookK o) => o -> m Bool getNotebookScrollable obj = liftIO $ getObjectPropertyBool obj "scrollable" setNotebookScrollable :: (MonadIO m, NotebookK o) => o -> Bool -> m () setNotebookScrollable obj val = liftIO $ setObjectPropertyBool obj "scrollable" val constructNotebookScrollable :: Bool -> IO ([Char], GValue) constructNotebookScrollable val = constructObjectPropertyBool "scrollable" val data NotebookScrollablePropertyInfo instance AttrInfo NotebookScrollablePropertyInfo where type AttrAllowedOps NotebookScrollablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookScrollablePropertyInfo = (~) Bool type AttrBaseTypeConstraint NotebookScrollablePropertyInfo = NotebookK type AttrGetType NotebookScrollablePropertyInfo = Bool type AttrLabel NotebookScrollablePropertyInfo = "Notebook::scrollable" attrGet _ = getNotebookScrollable attrSet _ = setNotebookScrollable attrConstruct _ = constructNotebookScrollable -- VVV Prop "show-border" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getNotebookShowBorder :: (MonadIO m, NotebookK o) => o -> m Bool getNotebookShowBorder obj = liftIO $ getObjectPropertyBool obj "show-border" setNotebookShowBorder :: (MonadIO m, NotebookK o) => o -> Bool -> m () setNotebookShowBorder obj val = liftIO $ setObjectPropertyBool obj "show-border" val constructNotebookShowBorder :: Bool -> IO ([Char], GValue) constructNotebookShowBorder val = constructObjectPropertyBool "show-border" val data NotebookShowBorderPropertyInfo instance AttrInfo NotebookShowBorderPropertyInfo where type AttrAllowedOps NotebookShowBorderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookShowBorderPropertyInfo = (~) Bool type AttrBaseTypeConstraint NotebookShowBorderPropertyInfo = NotebookK type AttrGetType NotebookShowBorderPropertyInfo = Bool type AttrLabel NotebookShowBorderPropertyInfo = "Notebook::show-border" attrGet _ = getNotebookShowBorder attrSet _ = setNotebookShowBorder attrConstruct _ = constructNotebookShowBorder -- VVV Prop "show-tabs" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getNotebookShowTabs :: (MonadIO m, NotebookK o) => o -> m Bool getNotebookShowTabs obj = liftIO $ getObjectPropertyBool obj "show-tabs" setNotebookShowTabs :: (MonadIO m, NotebookK o) => o -> Bool -> m () setNotebookShowTabs obj val = liftIO $ setObjectPropertyBool obj "show-tabs" val constructNotebookShowTabs :: Bool -> IO ([Char], GValue) constructNotebookShowTabs val = constructObjectPropertyBool "show-tabs" val data NotebookShowTabsPropertyInfo instance AttrInfo NotebookShowTabsPropertyInfo where type AttrAllowedOps NotebookShowTabsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookShowTabsPropertyInfo = (~) Bool type AttrBaseTypeConstraint NotebookShowTabsPropertyInfo = NotebookK type AttrGetType NotebookShowTabsPropertyInfo = Bool type AttrLabel NotebookShowTabsPropertyInfo = "Notebook::show-tabs" attrGet _ = getNotebookShowTabs attrSet _ = setNotebookShowTabs attrConstruct _ = constructNotebookShowTabs -- VVV Prop "tab-pos" -- Type: TInterface "Gtk" "PositionType" -- Flags: [PropertyReadable,PropertyWritable] getNotebookTabPos :: (MonadIO m, NotebookK o) => o -> m PositionType getNotebookTabPos obj = liftIO $ getObjectPropertyEnum obj "tab-pos" setNotebookTabPos :: (MonadIO m, NotebookK o) => o -> PositionType -> m () setNotebookTabPos obj val = liftIO $ setObjectPropertyEnum obj "tab-pos" val constructNotebookTabPos :: PositionType -> IO ([Char], GValue) constructNotebookTabPos val = constructObjectPropertyEnum "tab-pos" val data NotebookTabPosPropertyInfo instance AttrInfo NotebookTabPosPropertyInfo where type AttrAllowedOps NotebookTabPosPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookTabPosPropertyInfo = (~) PositionType type AttrBaseTypeConstraint NotebookTabPosPropertyInfo = NotebookK type AttrGetType NotebookTabPosPropertyInfo = PositionType type AttrLabel NotebookTabPosPropertyInfo = "Notebook::tab-pos" attrGet _ = getNotebookTabPos attrSet _ = setNotebookTabPos attrConstruct _ = constructNotebookTabPos type instance AttributeList Notebook = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("enable-popup", NotebookEnablePopupPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("group-name", NotebookGroupNamePropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("page", NotebookPagePropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("scrollable", NotebookScrollablePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-border", NotebookShowBorderPropertyInfo), '("show-tabs", NotebookShowTabsPropertyInfo), '("style", WidgetStylePropertyInfo), '("tab-pos", NotebookTabPosPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList NotebookAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList NotebookPageAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo)] -- VVV Prop "background-icon" -- Type: TInterface "Gio" "Icon" -- Flags: [PropertyReadable,PropertyWritable] getNumerableIconBackgroundIcon :: (MonadIO m, NumerableIconK o) => o -> m Gio.Icon getNumerableIconBackgroundIcon obj = liftIO $ getObjectPropertyObject obj "background-icon" Gio.Icon setNumerableIconBackgroundIcon :: (MonadIO m, NumerableIconK o, Gio.IconK a) => o -> a -> m () setNumerableIconBackgroundIcon obj val = liftIO $ setObjectPropertyObject obj "background-icon" val constructNumerableIconBackgroundIcon :: (Gio.IconK a) => a -> IO ([Char], GValue) constructNumerableIconBackgroundIcon val = constructObjectPropertyObject "background-icon" val data NumerableIconBackgroundIconPropertyInfo instance AttrInfo NumerableIconBackgroundIconPropertyInfo where type AttrAllowedOps NumerableIconBackgroundIconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NumerableIconBackgroundIconPropertyInfo = Gio.IconK type AttrBaseTypeConstraint NumerableIconBackgroundIconPropertyInfo = NumerableIconK type AttrGetType NumerableIconBackgroundIconPropertyInfo = Gio.Icon type AttrLabel NumerableIconBackgroundIconPropertyInfo = "NumerableIcon::background-icon" attrGet _ = getNumerableIconBackgroundIcon attrSet _ = setNumerableIconBackgroundIcon attrConstruct _ = constructNumerableIconBackgroundIcon -- VVV Prop "background-icon-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getNumerableIconBackgroundIconName :: (MonadIO m, NumerableIconK o) => o -> m T.Text getNumerableIconBackgroundIconName obj = liftIO $ getObjectPropertyString obj "background-icon-name" setNumerableIconBackgroundIconName :: (MonadIO m, NumerableIconK o) => o -> T.Text -> m () setNumerableIconBackgroundIconName obj val = liftIO $ setObjectPropertyString obj "background-icon-name" val constructNumerableIconBackgroundIconName :: T.Text -> IO ([Char], GValue) constructNumerableIconBackgroundIconName val = constructObjectPropertyString "background-icon-name" val data NumerableIconBackgroundIconNamePropertyInfo instance AttrInfo NumerableIconBackgroundIconNamePropertyInfo where type AttrAllowedOps NumerableIconBackgroundIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NumerableIconBackgroundIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint NumerableIconBackgroundIconNamePropertyInfo = NumerableIconK type AttrGetType NumerableIconBackgroundIconNamePropertyInfo = T.Text type AttrLabel NumerableIconBackgroundIconNamePropertyInfo = "NumerableIcon::background-icon-name" attrGet _ = getNumerableIconBackgroundIconName attrSet _ = setNumerableIconBackgroundIconName attrConstruct _ = constructNumerableIconBackgroundIconName -- VVV Prop "count" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getNumerableIconCount :: (MonadIO m, NumerableIconK o) => o -> m Int32 getNumerableIconCount obj = liftIO $ getObjectPropertyCInt obj "count" setNumerableIconCount :: (MonadIO m, NumerableIconK o) => o -> Int32 -> m () setNumerableIconCount obj val = liftIO $ setObjectPropertyCInt obj "count" val constructNumerableIconCount :: Int32 -> IO ([Char], GValue) constructNumerableIconCount val = constructObjectPropertyCInt "count" val data NumerableIconCountPropertyInfo instance AttrInfo NumerableIconCountPropertyInfo where type AttrAllowedOps NumerableIconCountPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NumerableIconCountPropertyInfo = (~) Int32 type AttrBaseTypeConstraint NumerableIconCountPropertyInfo = NumerableIconK type AttrGetType NumerableIconCountPropertyInfo = Int32 type AttrLabel NumerableIconCountPropertyInfo = "NumerableIcon::count" attrGet _ = getNumerableIconCount attrSet _ = setNumerableIconCount attrConstruct _ = constructNumerableIconCount -- VVV Prop "label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getNumerableIconLabel :: (MonadIO m, NumerableIconK o) => o -> m T.Text getNumerableIconLabel obj = liftIO $ getObjectPropertyString obj "label" setNumerableIconLabel :: (MonadIO m, NumerableIconK o) => o -> T.Text -> m () setNumerableIconLabel obj val = liftIO $ setObjectPropertyString obj "label" val constructNumerableIconLabel :: T.Text -> IO ([Char], GValue) constructNumerableIconLabel val = constructObjectPropertyString "label" val data NumerableIconLabelPropertyInfo instance AttrInfo NumerableIconLabelPropertyInfo where type AttrAllowedOps NumerableIconLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NumerableIconLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint NumerableIconLabelPropertyInfo = NumerableIconK type AttrGetType NumerableIconLabelPropertyInfo = T.Text type AttrLabel NumerableIconLabelPropertyInfo = "NumerableIcon::label" attrGet _ = getNumerableIconLabel attrSet _ = setNumerableIconLabel attrConstruct _ = constructNumerableIconLabel -- VVV Prop "style-context" -- Type: TInterface "Gtk" "StyleContext" -- Flags: [PropertyReadable,PropertyWritable] getNumerableIconStyleContext :: (MonadIO m, NumerableIconK o) => o -> m StyleContext getNumerableIconStyleContext obj = liftIO $ getObjectPropertyObject obj "style-context" StyleContext setNumerableIconStyleContext :: (MonadIO m, NumerableIconK o, StyleContextK a) => o -> a -> m () setNumerableIconStyleContext obj val = liftIO $ setObjectPropertyObject obj "style-context" val constructNumerableIconStyleContext :: (StyleContextK a) => a -> IO ([Char], GValue) constructNumerableIconStyleContext val = constructObjectPropertyObject "style-context" val data NumerableIconStyleContextPropertyInfo instance AttrInfo NumerableIconStyleContextPropertyInfo where type AttrAllowedOps NumerableIconStyleContextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NumerableIconStyleContextPropertyInfo = StyleContextK type AttrBaseTypeConstraint NumerableIconStyleContextPropertyInfo = NumerableIconK type AttrGetType NumerableIconStyleContextPropertyInfo = StyleContext type AttrLabel NumerableIconStyleContextPropertyInfo = "NumerableIcon::style-context" attrGet _ = getNumerableIconStyleContext attrSet _ = setNumerableIconStyleContext attrConstruct _ = constructNumerableIconStyleContext type instance AttributeList NumerableIcon = '[ '("background-icon", NumerableIconBackgroundIconPropertyInfo), '("background-icon-name", NumerableIconBackgroundIconNamePropertyInfo), '("count", NumerableIconCountPropertyInfo), '("gicon", GioA.EmblemedIconGiconPropertyInfo), '("label", NumerableIconLabelPropertyInfo), '("style-context", NumerableIconStyleContextPropertyInfo)] type instance AttributeList OffscreenWindow = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] -- VVV Prop "orientation" -- Type: TInterface "Gtk" "Orientation" -- Flags: [PropertyReadable,PropertyWritable] getOrientableOrientation :: (MonadIO m, OrientableK o) => o -> m Orientation getOrientableOrientation obj = liftIO $ getObjectPropertyEnum obj "orientation" setOrientableOrientation :: (MonadIO m, OrientableK o) => o -> Orientation -> m () setOrientableOrientation obj val = liftIO $ setObjectPropertyEnum obj "orientation" val constructOrientableOrientation :: Orientation -> IO ([Char], GValue) constructOrientableOrientation val = constructObjectPropertyEnum "orientation" val data OrientableOrientationPropertyInfo instance AttrInfo OrientableOrientationPropertyInfo where type AttrAllowedOps OrientableOrientationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint OrientableOrientationPropertyInfo = (~) Orientation type AttrBaseTypeConstraint OrientableOrientationPropertyInfo = OrientableK type AttrGetType OrientableOrientationPropertyInfo = Orientation type AttrLabel OrientableOrientationPropertyInfo = "Orientable::orientation" attrGet _ = getOrientableOrientation attrSet _ = setOrientableOrientation attrConstruct _ = constructOrientableOrientation type instance AttributeList Orientable = '[ '("orientation", OrientableOrientationPropertyInfo)] type instance AttributeList Overlay = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList PageSetup = '[ ] -- VVV Prop "max-position" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getPanedMaxPosition :: (MonadIO m, PanedK o) => o -> m Int32 getPanedMaxPosition obj = liftIO $ getObjectPropertyCInt obj "max-position" data PanedMaxPositionPropertyInfo instance AttrInfo PanedMaxPositionPropertyInfo where type AttrAllowedOps PanedMaxPositionPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PanedMaxPositionPropertyInfo = (~) () type AttrBaseTypeConstraint PanedMaxPositionPropertyInfo = PanedK type AttrGetType PanedMaxPositionPropertyInfo = Int32 type AttrLabel PanedMaxPositionPropertyInfo = "Paned::max-position" attrGet _ = getPanedMaxPosition attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "min-position" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getPanedMinPosition :: (MonadIO m, PanedK o) => o -> m Int32 getPanedMinPosition obj = liftIO $ getObjectPropertyCInt obj "min-position" data PanedMinPositionPropertyInfo instance AttrInfo PanedMinPositionPropertyInfo where type AttrAllowedOps PanedMinPositionPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PanedMinPositionPropertyInfo = (~) () type AttrBaseTypeConstraint PanedMinPositionPropertyInfo = PanedK type AttrGetType PanedMinPositionPropertyInfo = Int32 type AttrLabel PanedMinPositionPropertyInfo = "Paned::min-position" attrGet _ = getPanedMinPosition attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "position" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getPanedPosition :: (MonadIO m, PanedK o) => o -> m Int32 getPanedPosition obj = liftIO $ getObjectPropertyCInt obj "position" setPanedPosition :: (MonadIO m, PanedK o) => o -> Int32 -> m () setPanedPosition obj val = liftIO $ setObjectPropertyCInt obj "position" val constructPanedPosition :: Int32 -> IO ([Char], GValue) constructPanedPosition val = constructObjectPropertyCInt "position" val data PanedPositionPropertyInfo instance AttrInfo PanedPositionPropertyInfo where type AttrAllowedOps PanedPositionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PanedPositionPropertyInfo = (~) Int32 type AttrBaseTypeConstraint PanedPositionPropertyInfo = PanedK type AttrGetType PanedPositionPropertyInfo = Int32 type AttrLabel PanedPositionPropertyInfo = "Paned::position" attrGet _ = getPanedPosition attrSet _ = setPanedPosition attrConstruct _ = constructPanedPosition -- VVV Prop "position-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPanedPositionSet :: (MonadIO m, PanedK o) => o -> m Bool getPanedPositionSet obj = liftIO $ getObjectPropertyBool obj "position-set" setPanedPositionSet :: (MonadIO m, PanedK o) => o -> Bool -> m () setPanedPositionSet obj val = liftIO $ setObjectPropertyBool obj "position-set" val constructPanedPositionSet :: Bool -> IO ([Char], GValue) constructPanedPositionSet val = constructObjectPropertyBool "position-set" val data PanedPositionSetPropertyInfo instance AttrInfo PanedPositionSetPropertyInfo where type AttrAllowedOps PanedPositionSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PanedPositionSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint PanedPositionSetPropertyInfo = PanedK type AttrGetType PanedPositionSetPropertyInfo = Bool type AttrLabel PanedPositionSetPropertyInfo = "Paned::position-set" attrGet _ = getPanedPositionSet attrSet _ = setPanedPositionSet attrConstruct _ = constructPanedPositionSet -- VVV Prop "wide-handle" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPanedWideHandle :: (MonadIO m, PanedK o) => o -> m Bool getPanedWideHandle obj = liftIO $ getObjectPropertyBool obj "wide-handle" setPanedWideHandle :: (MonadIO m, PanedK o) => o -> Bool -> m () setPanedWideHandle obj val = liftIO $ setObjectPropertyBool obj "wide-handle" val constructPanedWideHandle :: Bool -> IO ([Char], GValue) constructPanedWideHandle val = constructObjectPropertyBool "wide-handle" val data PanedWideHandlePropertyInfo instance AttrInfo PanedWideHandlePropertyInfo where type AttrAllowedOps PanedWideHandlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PanedWideHandlePropertyInfo = (~) Bool type AttrBaseTypeConstraint PanedWideHandlePropertyInfo = PanedK type AttrGetType PanedWideHandlePropertyInfo = Bool type AttrLabel PanedWideHandlePropertyInfo = "Paned::wide-handle" attrGet _ = getPanedWideHandle attrSet _ = setPanedWideHandle attrConstruct _ = constructPanedWideHandle type instance AttributeList Paned = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-position", PanedMaxPositionPropertyInfo), '("min-position", PanedMinPositionPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("position", PanedPositionPropertyInfo), '("position-set", PanedPositionSetPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("wide-handle", PanedWideHandlePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList PanedAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "local-only" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarLocalOnly :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarLocalOnly obj = liftIO $ getObjectPropertyBool obj "local-only" setPlacesSidebarLocalOnly :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarLocalOnly obj val = liftIO $ setObjectPropertyBool obj "local-only" val constructPlacesSidebarLocalOnly :: Bool -> IO ([Char], GValue) constructPlacesSidebarLocalOnly val = constructObjectPropertyBool "local-only" val data PlacesSidebarLocalOnlyPropertyInfo instance AttrInfo PlacesSidebarLocalOnlyPropertyInfo where type AttrAllowedOps PlacesSidebarLocalOnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarLocalOnlyPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarLocalOnlyPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarLocalOnlyPropertyInfo = Bool type AttrLabel PlacesSidebarLocalOnlyPropertyInfo = "PlacesSidebar::local-only" attrGet _ = getPlacesSidebarLocalOnly attrSet _ = setPlacesSidebarLocalOnly attrConstruct _ = constructPlacesSidebarLocalOnly -- VVV Prop "location" -- Type: TInterface "Gio" "File" -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarLocation :: (MonadIO m, PlacesSidebarK o) => o -> m Gio.File getPlacesSidebarLocation obj = liftIO $ getObjectPropertyObject obj "location" Gio.File setPlacesSidebarLocation :: (MonadIO m, PlacesSidebarK o, Gio.FileK a) => o -> a -> m () setPlacesSidebarLocation obj val = liftIO $ setObjectPropertyObject obj "location" val constructPlacesSidebarLocation :: (Gio.FileK a) => a -> IO ([Char], GValue) constructPlacesSidebarLocation val = constructObjectPropertyObject "location" val data PlacesSidebarLocationPropertyInfo instance AttrInfo PlacesSidebarLocationPropertyInfo where type AttrAllowedOps PlacesSidebarLocationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarLocationPropertyInfo = Gio.FileK type AttrBaseTypeConstraint PlacesSidebarLocationPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarLocationPropertyInfo = Gio.File type AttrLabel PlacesSidebarLocationPropertyInfo = "PlacesSidebar::location" attrGet _ = getPlacesSidebarLocation attrSet _ = setPlacesSidebarLocation attrConstruct _ = constructPlacesSidebarLocation -- VVV Prop "open-flags" -- Type: TInterface "Gtk" "PlacesOpenFlags" -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarOpenFlags :: (MonadIO m, PlacesSidebarK o) => o -> m [PlacesOpenFlags] getPlacesSidebarOpenFlags obj = liftIO $ getObjectPropertyFlags obj "open-flags" setPlacesSidebarOpenFlags :: (MonadIO m, PlacesSidebarK o) => o -> [PlacesOpenFlags] -> m () setPlacesSidebarOpenFlags obj val = liftIO $ setObjectPropertyFlags obj "open-flags" val constructPlacesSidebarOpenFlags :: [PlacesOpenFlags] -> IO ([Char], GValue) constructPlacesSidebarOpenFlags val = constructObjectPropertyFlags "open-flags" val data PlacesSidebarOpenFlagsPropertyInfo instance AttrInfo PlacesSidebarOpenFlagsPropertyInfo where type AttrAllowedOps PlacesSidebarOpenFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarOpenFlagsPropertyInfo = (~) [PlacesOpenFlags] type AttrBaseTypeConstraint PlacesSidebarOpenFlagsPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarOpenFlagsPropertyInfo = [PlacesOpenFlags] type AttrLabel PlacesSidebarOpenFlagsPropertyInfo = "PlacesSidebar::open-flags" attrGet _ = getPlacesSidebarOpenFlags attrSet _ = setPlacesSidebarOpenFlags attrConstruct _ = constructPlacesSidebarOpenFlags -- VVV Prop "populate-all" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarPopulateAll :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarPopulateAll obj = liftIO $ getObjectPropertyBool obj "populate-all" setPlacesSidebarPopulateAll :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarPopulateAll obj val = liftIO $ setObjectPropertyBool obj "populate-all" val constructPlacesSidebarPopulateAll :: Bool -> IO ([Char], GValue) constructPlacesSidebarPopulateAll val = constructObjectPropertyBool "populate-all" val data PlacesSidebarPopulateAllPropertyInfo instance AttrInfo PlacesSidebarPopulateAllPropertyInfo where type AttrAllowedOps PlacesSidebarPopulateAllPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarPopulateAllPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarPopulateAllPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarPopulateAllPropertyInfo = Bool type AttrLabel PlacesSidebarPopulateAllPropertyInfo = "PlacesSidebar::populate-all" attrGet _ = getPlacesSidebarPopulateAll attrSet _ = setPlacesSidebarPopulateAll attrConstruct _ = constructPlacesSidebarPopulateAll -- VVV Prop "show-connect-to-server" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarShowConnectToServer :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarShowConnectToServer obj = liftIO $ getObjectPropertyBool obj "show-connect-to-server" setPlacesSidebarShowConnectToServer :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarShowConnectToServer obj val = liftIO $ setObjectPropertyBool obj "show-connect-to-server" val constructPlacesSidebarShowConnectToServer :: Bool -> IO ([Char], GValue) constructPlacesSidebarShowConnectToServer val = constructObjectPropertyBool "show-connect-to-server" val data PlacesSidebarShowConnectToServerPropertyInfo instance AttrInfo PlacesSidebarShowConnectToServerPropertyInfo where type AttrAllowedOps PlacesSidebarShowConnectToServerPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarShowConnectToServerPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarShowConnectToServerPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarShowConnectToServerPropertyInfo = Bool type AttrLabel PlacesSidebarShowConnectToServerPropertyInfo = "PlacesSidebar::show-connect-to-server" attrGet _ = getPlacesSidebarShowConnectToServer attrSet _ = setPlacesSidebarShowConnectToServer attrConstruct _ = constructPlacesSidebarShowConnectToServer -- VVV Prop "show-desktop" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarShowDesktop :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarShowDesktop obj = liftIO $ getObjectPropertyBool obj "show-desktop" setPlacesSidebarShowDesktop :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarShowDesktop obj val = liftIO $ setObjectPropertyBool obj "show-desktop" val constructPlacesSidebarShowDesktop :: Bool -> IO ([Char], GValue) constructPlacesSidebarShowDesktop val = constructObjectPropertyBool "show-desktop" val data PlacesSidebarShowDesktopPropertyInfo instance AttrInfo PlacesSidebarShowDesktopPropertyInfo where type AttrAllowedOps PlacesSidebarShowDesktopPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarShowDesktopPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarShowDesktopPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarShowDesktopPropertyInfo = Bool type AttrLabel PlacesSidebarShowDesktopPropertyInfo = "PlacesSidebar::show-desktop" attrGet _ = getPlacesSidebarShowDesktop attrSet _ = setPlacesSidebarShowDesktop attrConstruct _ = constructPlacesSidebarShowDesktop -- VVV Prop "show-enter-location" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarShowEnterLocation :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarShowEnterLocation obj = liftIO $ getObjectPropertyBool obj "show-enter-location" setPlacesSidebarShowEnterLocation :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarShowEnterLocation obj val = liftIO $ setObjectPropertyBool obj "show-enter-location" val constructPlacesSidebarShowEnterLocation :: Bool -> IO ([Char], GValue) constructPlacesSidebarShowEnterLocation val = constructObjectPropertyBool "show-enter-location" val data PlacesSidebarShowEnterLocationPropertyInfo instance AttrInfo PlacesSidebarShowEnterLocationPropertyInfo where type AttrAllowedOps PlacesSidebarShowEnterLocationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarShowEnterLocationPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarShowEnterLocationPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarShowEnterLocationPropertyInfo = Bool type AttrLabel PlacesSidebarShowEnterLocationPropertyInfo = "PlacesSidebar::show-enter-location" attrGet _ = getPlacesSidebarShowEnterLocation attrSet _ = setPlacesSidebarShowEnterLocation attrConstruct _ = constructPlacesSidebarShowEnterLocation -- VVV Prop "show-other-locations" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarShowOtherLocations :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarShowOtherLocations obj = liftIO $ getObjectPropertyBool obj "show-other-locations" setPlacesSidebarShowOtherLocations :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarShowOtherLocations obj val = liftIO $ setObjectPropertyBool obj "show-other-locations" val constructPlacesSidebarShowOtherLocations :: Bool -> IO ([Char], GValue) constructPlacesSidebarShowOtherLocations val = constructObjectPropertyBool "show-other-locations" val data PlacesSidebarShowOtherLocationsPropertyInfo instance AttrInfo PlacesSidebarShowOtherLocationsPropertyInfo where type AttrAllowedOps PlacesSidebarShowOtherLocationsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarShowOtherLocationsPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarShowOtherLocationsPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarShowOtherLocationsPropertyInfo = Bool type AttrLabel PlacesSidebarShowOtherLocationsPropertyInfo = "PlacesSidebar::show-other-locations" attrGet _ = getPlacesSidebarShowOtherLocations attrSet _ = setPlacesSidebarShowOtherLocations attrConstruct _ = constructPlacesSidebarShowOtherLocations -- VVV Prop "show-recent" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarShowRecent :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarShowRecent obj = liftIO $ getObjectPropertyBool obj "show-recent" setPlacesSidebarShowRecent :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarShowRecent obj val = liftIO $ setObjectPropertyBool obj "show-recent" val constructPlacesSidebarShowRecent :: Bool -> IO ([Char], GValue) constructPlacesSidebarShowRecent val = constructObjectPropertyBool "show-recent" val data PlacesSidebarShowRecentPropertyInfo instance AttrInfo PlacesSidebarShowRecentPropertyInfo where type AttrAllowedOps PlacesSidebarShowRecentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarShowRecentPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarShowRecentPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarShowRecentPropertyInfo = Bool type AttrLabel PlacesSidebarShowRecentPropertyInfo = "PlacesSidebar::show-recent" attrGet _ = getPlacesSidebarShowRecent attrSet _ = setPlacesSidebarShowRecent attrConstruct _ = constructPlacesSidebarShowRecent -- VVV Prop "show-trash" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPlacesSidebarShowTrash :: (MonadIO m, PlacesSidebarK o) => o -> m Bool getPlacesSidebarShowTrash obj = liftIO $ getObjectPropertyBool obj "show-trash" setPlacesSidebarShowTrash :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m () setPlacesSidebarShowTrash obj val = liftIO $ setObjectPropertyBool obj "show-trash" val constructPlacesSidebarShowTrash :: Bool -> IO ([Char], GValue) constructPlacesSidebarShowTrash val = constructObjectPropertyBool "show-trash" val data PlacesSidebarShowTrashPropertyInfo instance AttrInfo PlacesSidebarShowTrashPropertyInfo where type AttrAllowedOps PlacesSidebarShowTrashPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PlacesSidebarShowTrashPropertyInfo = (~) Bool type AttrBaseTypeConstraint PlacesSidebarShowTrashPropertyInfo = PlacesSidebarK type AttrGetType PlacesSidebarShowTrashPropertyInfo = Bool type AttrLabel PlacesSidebarShowTrashPropertyInfo = "PlacesSidebar::show-trash" attrGet _ = getPlacesSidebarShowTrash attrSet _ = setPlacesSidebarShowTrash attrConstruct _ = constructPlacesSidebarShowTrash type instance AttributeList PlacesSidebar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("hadjustment", ScrolledWindowHadjustmentPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hscrollbar-policy", ScrolledWindowHscrollbarPolicyPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("kinetic-scrolling", ScrolledWindowKineticScrollingPropertyInfo), '("local-only", PlacesSidebarLocalOnlyPropertyInfo), '("location", PlacesSidebarLocationPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("min-content-height", ScrolledWindowMinContentHeightPropertyInfo), '("min-content-width", ScrolledWindowMinContentWidthPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("open-flags", PlacesSidebarOpenFlagsPropertyInfo), '("overlay-scrolling", ScrolledWindowOverlayScrollingPropertyInfo), '("parent", WidgetParentPropertyInfo), '("populate-all", PlacesSidebarPopulateAllPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", ScrolledWindowShadowTypePropertyInfo), '("show-connect-to-server", PlacesSidebarShowConnectToServerPropertyInfo), '("show-desktop", PlacesSidebarShowDesktopPropertyInfo), '("show-enter-location", PlacesSidebarShowEnterLocationPropertyInfo), '("show-other-locations", PlacesSidebarShowOtherLocationsPropertyInfo), '("show-recent", PlacesSidebarShowRecentPropertyInfo), '("show-trash", PlacesSidebarShowTrashPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("vadjustment", ScrolledWindowVadjustmentPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("vscrollbar-policy", ScrolledWindowVscrollbarPolicyPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-placement", ScrolledWindowWindowPlacementPropertyInfo), '("window-placement-set", ScrolledWindowWindowPlacementSetPropertyInfo)] -- VVV Prop "embedded" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getPlugEmbedded :: (MonadIO m, PlugK o) => o -> m Bool getPlugEmbedded obj = liftIO $ getObjectPropertyBool obj "embedded" data PlugEmbeddedPropertyInfo instance AttrInfo PlugEmbeddedPropertyInfo where type AttrAllowedOps PlugEmbeddedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PlugEmbeddedPropertyInfo = (~) () type AttrBaseTypeConstraint PlugEmbeddedPropertyInfo = PlugK type AttrGetType PlugEmbeddedPropertyInfo = Bool type AttrLabel PlugEmbeddedPropertyInfo = "Plug::embedded" attrGet _ = getPlugEmbedded attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "socket-window" -- Type: TInterface "Gdk" "Window" -- Flags: [PropertyReadable] getPlugSocketWindow :: (MonadIO m, PlugK o) => o -> m Gdk.Window getPlugSocketWindow obj = liftIO $ getObjectPropertyObject obj "socket-window" Gdk.Window data PlugSocketWindowPropertyInfo instance AttrInfo PlugSocketWindowPropertyInfo where type AttrAllowedOps PlugSocketWindowPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PlugSocketWindowPropertyInfo = (~) () type AttrBaseTypeConstraint PlugSocketWindowPropertyInfo = PlugK type AttrGetType PlugSocketWindowPropertyInfo = Gdk.Window type AttrLabel PlugSocketWindowPropertyInfo = "Plug::socket-window" attrGet _ = getPlugSocketWindow attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList Plug = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("embedded", PlugEmbeddedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("socket-window", PlugSocketWindowPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] -- VVV Prop "modal" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPopoverModal :: (MonadIO m, PopoverK o) => o -> m Bool getPopoverModal obj = liftIO $ getObjectPropertyBool obj "modal" setPopoverModal :: (MonadIO m, PopoverK o) => o -> Bool -> m () setPopoverModal obj val = liftIO $ setObjectPropertyBool obj "modal" val constructPopoverModal :: Bool -> IO ([Char], GValue) constructPopoverModal val = constructObjectPropertyBool "modal" val data PopoverModalPropertyInfo instance AttrInfo PopoverModalPropertyInfo where type AttrAllowedOps PopoverModalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PopoverModalPropertyInfo = (~) Bool type AttrBaseTypeConstraint PopoverModalPropertyInfo = PopoverK type AttrGetType PopoverModalPropertyInfo = Bool type AttrLabel PopoverModalPropertyInfo = "Popover::modal" attrGet _ = getPopoverModal attrSet _ = setPopoverModal attrConstruct _ = constructPopoverModal -- VVV Prop "pointing-to" -- Type: TInterface "Gdk" "Rectangle" -- Flags: [PropertyReadable,PropertyWritable] getPopoverPointingTo :: (MonadIO m, PopoverK o) => o -> m Gdk.Rectangle getPopoverPointingTo obj = liftIO $ getObjectPropertyBoxed obj "pointing-to" Gdk.Rectangle setPopoverPointingTo :: (MonadIO m, PopoverK o) => o -> Gdk.Rectangle -> m () setPopoverPointingTo obj val = liftIO $ setObjectPropertyBoxed obj "pointing-to" val constructPopoverPointingTo :: Gdk.Rectangle -> IO ([Char], GValue) constructPopoverPointingTo val = constructObjectPropertyBoxed "pointing-to" val data PopoverPointingToPropertyInfo instance AttrInfo PopoverPointingToPropertyInfo where type AttrAllowedOps PopoverPointingToPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PopoverPointingToPropertyInfo = (~) Gdk.Rectangle type AttrBaseTypeConstraint PopoverPointingToPropertyInfo = PopoverK type AttrGetType PopoverPointingToPropertyInfo = Gdk.Rectangle type AttrLabel PopoverPointingToPropertyInfo = "Popover::pointing-to" attrGet _ = getPopoverPointingTo attrSet _ = setPopoverPointingTo attrConstruct _ = constructPopoverPointingTo -- VVV Prop "position" -- Type: TInterface "Gtk" "PositionType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getPopoverPosition :: (MonadIO m, PopoverK o) => o -> m PositionType getPopoverPosition obj = liftIO $ getObjectPropertyEnum obj "position" setPopoverPosition :: (MonadIO m, PopoverK o) => o -> PositionType -> m () setPopoverPosition obj val = liftIO $ setObjectPropertyEnum obj "position" val constructPopoverPosition :: PositionType -> IO ([Char], GValue) constructPopoverPosition val = constructObjectPropertyEnum "position" val data PopoverPositionPropertyInfo instance AttrInfo PopoverPositionPropertyInfo where type AttrAllowedOps PopoverPositionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PopoverPositionPropertyInfo = (~) PositionType type AttrBaseTypeConstraint PopoverPositionPropertyInfo = PopoverK type AttrGetType PopoverPositionPropertyInfo = PositionType type AttrLabel PopoverPositionPropertyInfo = "Popover::position" attrGet _ = getPopoverPosition attrSet _ = setPopoverPosition attrConstruct _ = constructPopoverPosition -- VVV Prop "relative-to" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getPopoverRelativeTo :: (MonadIO m, PopoverK o) => o -> m Widget getPopoverRelativeTo obj = liftIO $ getObjectPropertyObject obj "relative-to" Widget setPopoverRelativeTo :: (MonadIO m, PopoverK o, WidgetK a) => o -> a -> m () setPopoverRelativeTo obj val = liftIO $ setObjectPropertyObject obj "relative-to" val constructPopoverRelativeTo :: (WidgetK a) => a -> IO ([Char], GValue) constructPopoverRelativeTo val = constructObjectPropertyObject "relative-to" val data PopoverRelativeToPropertyInfo instance AttrInfo PopoverRelativeToPropertyInfo where type AttrAllowedOps PopoverRelativeToPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PopoverRelativeToPropertyInfo = WidgetK type AttrBaseTypeConstraint PopoverRelativeToPropertyInfo = PopoverK type AttrGetType PopoverRelativeToPropertyInfo = Widget type AttrLabel PopoverRelativeToPropertyInfo = "Popover::relative-to" attrGet _ = getPopoverRelativeTo attrSet _ = setPopoverRelativeTo attrConstruct _ = constructPopoverRelativeTo -- VVV Prop "transitions-enabled" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPopoverTransitionsEnabled :: (MonadIO m, PopoverK o) => o -> m Bool getPopoverTransitionsEnabled obj = liftIO $ getObjectPropertyBool obj "transitions-enabled" setPopoverTransitionsEnabled :: (MonadIO m, PopoverK o) => o -> Bool -> m () setPopoverTransitionsEnabled obj val = liftIO $ setObjectPropertyBool obj "transitions-enabled" val constructPopoverTransitionsEnabled :: Bool -> IO ([Char], GValue) constructPopoverTransitionsEnabled val = constructObjectPropertyBool "transitions-enabled" val data PopoverTransitionsEnabledPropertyInfo instance AttrInfo PopoverTransitionsEnabledPropertyInfo where type AttrAllowedOps PopoverTransitionsEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PopoverTransitionsEnabledPropertyInfo = (~) Bool type AttrBaseTypeConstraint PopoverTransitionsEnabledPropertyInfo = PopoverK type AttrGetType PopoverTransitionsEnabledPropertyInfo = Bool type AttrLabel PopoverTransitionsEnabledPropertyInfo = "Popover::transitions-enabled" attrGet _ = getPopoverTransitionsEnabled attrSet _ = setPopoverTransitionsEnabled attrConstruct _ = constructPopoverTransitionsEnabled type instance AttributeList Popover = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("modal", PopoverModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("pointing-to", PopoverPointingToPropertyInfo), '("position", PopoverPositionPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("relative-to", PopoverRelativeToPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transitions-enabled", PopoverTransitionsEnabledPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList PopoverAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "visible-submenu" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getPopoverMenuVisibleSubmenu :: (MonadIO m, PopoverMenuK o) => o -> m T.Text getPopoverMenuVisibleSubmenu obj = liftIO $ getObjectPropertyString obj "visible-submenu" setPopoverMenuVisibleSubmenu :: (MonadIO m, PopoverMenuK o) => o -> T.Text -> m () setPopoverMenuVisibleSubmenu obj val = liftIO $ setObjectPropertyString obj "visible-submenu" val constructPopoverMenuVisibleSubmenu :: T.Text -> IO ([Char], GValue) constructPopoverMenuVisibleSubmenu val = constructObjectPropertyString "visible-submenu" val data PopoverMenuVisibleSubmenuPropertyInfo instance AttrInfo PopoverMenuVisibleSubmenuPropertyInfo where type AttrAllowedOps PopoverMenuVisibleSubmenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PopoverMenuVisibleSubmenuPropertyInfo = (~) T.Text type AttrBaseTypeConstraint PopoverMenuVisibleSubmenuPropertyInfo = PopoverMenuK type AttrGetType PopoverMenuVisibleSubmenuPropertyInfo = T.Text type AttrLabel PopoverMenuVisibleSubmenuPropertyInfo = "PopoverMenu::visible-submenu" attrGet _ = getPopoverMenuVisibleSubmenu attrSet _ = setPopoverMenuVisibleSubmenu attrConstruct _ = constructPopoverMenuVisibleSubmenu type instance AttributeList PopoverMenu = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("modal", PopoverModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("pointing-to", PopoverPointingToPropertyInfo), '("position", PopoverPositionPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("relative-to", PopoverRelativeToPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transitions-enabled", PopoverTransitionsEnabledPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("visible-submenu", PopoverMenuVisibleSubmenuPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList PrintContext = '[ ] -- VVV Prop "allow-async" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationAllowAsync :: (MonadIO m, PrintOperationK o) => o -> m Bool getPrintOperationAllowAsync obj = liftIO $ getObjectPropertyBool obj "allow-async" setPrintOperationAllowAsync :: (MonadIO m, PrintOperationK o) => o -> Bool -> m () setPrintOperationAllowAsync obj val = liftIO $ setObjectPropertyBool obj "allow-async" val constructPrintOperationAllowAsync :: Bool -> IO ([Char], GValue) constructPrintOperationAllowAsync val = constructObjectPropertyBool "allow-async" val data PrintOperationAllowAsyncPropertyInfo instance AttrInfo PrintOperationAllowAsyncPropertyInfo where type AttrAllowedOps PrintOperationAllowAsyncPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationAllowAsyncPropertyInfo = (~) Bool type AttrBaseTypeConstraint PrintOperationAllowAsyncPropertyInfo = PrintOperationK type AttrGetType PrintOperationAllowAsyncPropertyInfo = Bool type AttrLabel PrintOperationAllowAsyncPropertyInfo = "PrintOperation::allow-async" attrGet _ = getPrintOperationAllowAsync attrSet _ = setPrintOperationAllowAsync attrConstruct _ = constructPrintOperationAllowAsync -- VVV Prop "current-page" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationCurrentPage :: (MonadIO m, PrintOperationK o) => o -> m Int32 getPrintOperationCurrentPage obj = liftIO $ getObjectPropertyCInt obj "current-page" setPrintOperationCurrentPage :: (MonadIO m, PrintOperationK o) => o -> Int32 -> m () setPrintOperationCurrentPage obj val = liftIO $ setObjectPropertyCInt obj "current-page" val constructPrintOperationCurrentPage :: Int32 -> IO ([Char], GValue) constructPrintOperationCurrentPage val = constructObjectPropertyCInt "current-page" val data PrintOperationCurrentPagePropertyInfo instance AttrInfo PrintOperationCurrentPagePropertyInfo where type AttrAllowedOps PrintOperationCurrentPagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationCurrentPagePropertyInfo = (~) Int32 type AttrBaseTypeConstraint PrintOperationCurrentPagePropertyInfo = PrintOperationK type AttrGetType PrintOperationCurrentPagePropertyInfo = Int32 type AttrLabel PrintOperationCurrentPagePropertyInfo = "PrintOperation::current-page" attrGet _ = getPrintOperationCurrentPage attrSet _ = setPrintOperationCurrentPage attrConstruct _ = constructPrintOperationCurrentPage -- VVV Prop "custom-tab-label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationCustomTabLabel :: (MonadIO m, PrintOperationK o) => o -> m T.Text getPrintOperationCustomTabLabel obj = liftIO $ getObjectPropertyString obj "custom-tab-label" setPrintOperationCustomTabLabel :: (MonadIO m, PrintOperationK o) => o -> T.Text -> m () setPrintOperationCustomTabLabel obj val = liftIO $ setObjectPropertyString obj "custom-tab-label" val constructPrintOperationCustomTabLabel :: T.Text -> IO ([Char], GValue) constructPrintOperationCustomTabLabel val = constructObjectPropertyString "custom-tab-label" val data PrintOperationCustomTabLabelPropertyInfo instance AttrInfo PrintOperationCustomTabLabelPropertyInfo where type AttrAllowedOps PrintOperationCustomTabLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationCustomTabLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint PrintOperationCustomTabLabelPropertyInfo = PrintOperationK type AttrGetType PrintOperationCustomTabLabelPropertyInfo = T.Text type AttrLabel PrintOperationCustomTabLabelPropertyInfo = "PrintOperation::custom-tab-label" attrGet _ = getPrintOperationCustomTabLabel attrSet _ = setPrintOperationCustomTabLabel attrConstruct _ = constructPrintOperationCustomTabLabel -- VVV Prop "default-page-setup" -- Type: TInterface "Gtk" "PageSetup" -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationDefaultPageSetup :: (MonadIO m, PrintOperationK o) => o -> m PageSetup getPrintOperationDefaultPageSetup obj = liftIO $ getObjectPropertyObject obj "default-page-setup" PageSetup setPrintOperationDefaultPageSetup :: (MonadIO m, PrintOperationK o, PageSetupK a) => o -> a -> m () setPrintOperationDefaultPageSetup obj val = liftIO $ setObjectPropertyObject obj "default-page-setup" val constructPrintOperationDefaultPageSetup :: (PageSetupK a) => a -> IO ([Char], GValue) constructPrintOperationDefaultPageSetup val = constructObjectPropertyObject "default-page-setup" val data PrintOperationDefaultPageSetupPropertyInfo instance AttrInfo PrintOperationDefaultPageSetupPropertyInfo where type AttrAllowedOps PrintOperationDefaultPageSetupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationDefaultPageSetupPropertyInfo = PageSetupK type AttrBaseTypeConstraint PrintOperationDefaultPageSetupPropertyInfo = PrintOperationK type AttrGetType PrintOperationDefaultPageSetupPropertyInfo = PageSetup type AttrLabel PrintOperationDefaultPageSetupPropertyInfo = "PrintOperation::default-page-setup" attrGet _ = getPrintOperationDefaultPageSetup attrSet _ = setPrintOperationDefaultPageSetup attrConstruct _ = constructPrintOperationDefaultPageSetup -- VVV Prop "embed-page-setup" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationEmbedPageSetup :: (MonadIO m, PrintOperationK o) => o -> m Bool getPrintOperationEmbedPageSetup obj = liftIO $ getObjectPropertyBool obj "embed-page-setup" setPrintOperationEmbedPageSetup :: (MonadIO m, PrintOperationK o) => o -> Bool -> m () setPrintOperationEmbedPageSetup obj val = liftIO $ setObjectPropertyBool obj "embed-page-setup" val constructPrintOperationEmbedPageSetup :: Bool -> IO ([Char], GValue) constructPrintOperationEmbedPageSetup val = constructObjectPropertyBool "embed-page-setup" val data PrintOperationEmbedPageSetupPropertyInfo instance AttrInfo PrintOperationEmbedPageSetupPropertyInfo where type AttrAllowedOps PrintOperationEmbedPageSetupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationEmbedPageSetupPropertyInfo = (~) Bool type AttrBaseTypeConstraint PrintOperationEmbedPageSetupPropertyInfo = PrintOperationK type AttrGetType PrintOperationEmbedPageSetupPropertyInfo = Bool type AttrLabel PrintOperationEmbedPageSetupPropertyInfo = "PrintOperation::embed-page-setup" attrGet _ = getPrintOperationEmbedPageSetup attrSet _ = setPrintOperationEmbedPageSetup attrConstruct _ = constructPrintOperationEmbedPageSetup -- VVV Prop "export-filename" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationExportFilename :: (MonadIO m, PrintOperationK o) => o -> m T.Text getPrintOperationExportFilename obj = liftIO $ getObjectPropertyString obj "export-filename" setPrintOperationExportFilename :: (MonadIO m, PrintOperationK o) => o -> T.Text -> m () setPrintOperationExportFilename obj val = liftIO $ setObjectPropertyString obj "export-filename" val constructPrintOperationExportFilename :: T.Text -> IO ([Char], GValue) constructPrintOperationExportFilename val = constructObjectPropertyString "export-filename" val data PrintOperationExportFilenamePropertyInfo instance AttrInfo PrintOperationExportFilenamePropertyInfo where type AttrAllowedOps PrintOperationExportFilenamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationExportFilenamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint PrintOperationExportFilenamePropertyInfo = PrintOperationK type AttrGetType PrintOperationExportFilenamePropertyInfo = T.Text type AttrLabel PrintOperationExportFilenamePropertyInfo = "PrintOperation::export-filename" attrGet _ = getPrintOperationExportFilename attrSet _ = setPrintOperationExportFilename attrConstruct _ = constructPrintOperationExportFilename -- VVV Prop "has-selection" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationHasSelection :: (MonadIO m, PrintOperationK o) => o -> m Bool getPrintOperationHasSelection obj = liftIO $ getObjectPropertyBool obj "has-selection" setPrintOperationHasSelection :: (MonadIO m, PrintOperationK o) => o -> Bool -> m () setPrintOperationHasSelection obj val = liftIO $ setObjectPropertyBool obj "has-selection" val constructPrintOperationHasSelection :: Bool -> IO ([Char], GValue) constructPrintOperationHasSelection val = constructObjectPropertyBool "has-selection" val data PrintOperationHasSelectionPropertyInfo instance AttrInfo PrintOperationHasSelectionPropertyInfo where type AttrAllowedOps PrintOperationHasSelectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationHasSelectionPropertyInfo = (~) Bool type AttrBaseTypeConstraint PrintOperationHasSelectionPropertyInfo = PrintOperationK type AttrGetType PrintOperationHasSelectionPropertyInfo = Bool type AttrLabel PrintOperationHasSelectionPropertyInfo = "PrintOperation::has-selection" attrGet _ = getPrintOperationHasSelection attrSet _ = setPrintOperationHasSelection attrConstruct _ = constructPrintOperationHasSelection -- VVV Prop "job-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationJobName :: (MonadIO m, PrintOperationK o) => o -> m T.Text getPrintOperationJobName obj = liftIO $ getObjectPropertyString obj "job-name" setPrintOperationJobName :: (MonadIO m, PrintOperationK o) => o -> T.Text -> m () setPrintOperationJobName obj val = liftIO $ setObjectPropertyString obj "job-name" val constructPrintOperationJobName :: T.Text -> IO ([Char], GValue) constructPrintOperationJobName val = constructObjectPropertyString "job-name" val data PrintOperationJobNamePropertyInfo instance AttrInfo PrintOperationJobNamePropertyInfo where type AttrAllowedOps PrintOperationJobNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationJobNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint PrintOperationJobNamePropertyInfo = PrintOperationK type AttrGetType PrintOperationJobNamePropertyInfo = T.Text type AttrLabel PrintOperationJobNamePropertyInfo = "PrintOperation::job-name" attrGet _ = getPrintOperationJobName attrSet _ = setPrintOperationJobName attrConstruct _ = constructPrintOperationJobName -- VVV Prop "n-pages" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationNPages :: (MonadIO m, PrintOperationK o) => o -> m Int32 getPrintOperationNPages obj = liftIO $ getObjectPropertyCInt obj "n-pages" setPrintOperationNPages :: (MonadIO m, PrintOperationK o) => o -> Int32 -> m () setPrintOperationNPages obj val = liftIO $ setObjectPropertyCInt obj "n-pages" val constructPrintOperationNPages :: Int32 -> IO ([Char], GValue) constructPrintOperationNPages val = constructObjectPropertyCInt "n-pages" val data PrintOperationNPagesPropertyInfo instance AttrInfo PrintOperationNPagesPropertyInfo where type AttrAllowedOps PrintOperationNPagesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationNPagesPropertyInfo = (~) Int32 type AttrBaseTypeConstraint PrintOperationNPagesPropertyInfo = PrintOperationK type AttrGetType PrintOperationNPagesPropertyInfo = Int32 type AttrLabel PrintOperationNPagesPropertyInfo = "PrintOperation::n-pages" attrGet _ = getPrintOperationNPages attrSet _ = setPrintOperationNPages attrConstruct _ = constructPrintOperationNPages -- VVV Prop "n-pages-to-print" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getPrintOperationNPagesToPrint :: (MonadIO m, PrintOperationK o) => o -> m Int32 getPrintOperationNPagesToPrint obj = liftIO $ getObjectPropertyCInt obj "n-pages-to-print" data PrintOperationNPagesToPrintPropertyInfo instance AttrInfo PrintOperationNPagesToPrintPropertyInfo where type AttrAllowedOps PrintOperationNPagesToPrintPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PrintOperationNPagesToPrintPropertyInfo = (~) () type AttrBaseTypeConstraint PrintOperationNPagesToPrintPropertyInfo = PrintOperationK type AttrGetType PrintOperationNPagesToPrintPropertyInfo = Int32 type AttrLabel PrintOperationNPagesToPrintPropertyInfo = "PrintOperation::n-pages-to-print" attrGet _ = getPrintOperationNPagesToPrint attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "print-settings" -- Type: TInterface "Gtk" "PrintSettings" -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationPrintSettings :: (MonadIO m, PrintOperationK o) => o -> m PrintSettings getPrintOperationPrintSettings obj = liftIO $ getObjectPropertyObject obj "print-settings" PrintSettings setPrintOperationPrintSettings :: (MonadIO m, PrintOperationK o, PrintSettingsK a) => o -> a -> m () setPrintOperationPrintSettings obj val = liftIO $ setObjectPropertyObject obj "print-settings" val constructPrintOperationPrintSettings :: (PrintSettingsK a) => a -> IO ([Char], GValue) constructPrintOperationPrintSettings val = constructObjectPropertyObject "print-settings" val data PrintOperationPrintSettingsPropertyInfo instance AttrInfo PrintOperationPrintSettingsPropertyInfo where type AttrAllowedOps PrintOperationPrintSettingsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationPrintSettingsPropertyInfo = PrintSettingsK type AttrBaseTypeConstraint PrintOperationPrintSettingsPropertyInfo = PrintOperationK type AttrGetType PrintOperationPrintSettingsPropertyInfo = PrintSettings type AttrLabel PrintOperationPrintSettingsPropertyInfo = "PrintOperation::print-settings" attrGet _ = getPrintOperationPrintSettings attrSet _ = setPrintOperationPrintSettings attrConstruct _ = constructPrintOperationPrintSettings -- VVV Prop "show-progress" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationShowProgress :: (MonadIO m, PrintOperationK o) => o -> m Bool getPrintOperationShowProgress obj = liftIO $ getObjectPropertyBool obj "show-progress" setPrintOperationShowProgress :: (MonadIO m, PrintOperationK o) => o -> Bool -> m () setPrintOperationShowProgress obj val = liftIO $ setObjectPropertyBool obj "show-progress" val constructPrintOperationShowProgress :: Bool -> IO ([Char], GValue) constructPrintOperationShowProgress val = constructObjectPropertyBool "show-progress" val data PrintOperationShowProgressPropertyInfo instance AttrInfo PrintOperationShowProgressPropertyInfo where type AttrAllowedOps PrintOperationShowProgressPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationShowProgressPropertyInfo = (~) Bool type AttrBaseTypeConstraint PrintOperationShowProgressPropertyInfo = PrintOperationK type AttrGetType PrintOperationShowProgressPropertyInfo = Bool type AttrLabel PrintOperationShowProgressPropertyInfo = "PrintOperation::show-progress" attrGet _ = getPrintOperationShowProgress attrSet _ = setPrintOperationShowProgress attrConstruct _ = constructPrintOperationShowProgress -- VVV Prop "status" -- Type: TInterface "Gtk" "PrintStatus" -- Flags: [PropertyReadable] getPrintOperationStatus :: (MonadIO m, PrintOperationK o) => o -> m PrintStatus getPrintOperationStatus obj = liftIO $ getObjectPropertyEnum obj "status" data PrintOperationStatusPropertyInfo instance AttrInfo PrintOperationStatusPropertyInfo where type AttrAllowedOps PrintOperationStatusPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PrintOperationStatusPropertyInfo = (~) () type AttrBaseTypeConstraint PrintOperationStatusPropertyInfo = PrintOperationK type AttrGetType PrintOperationStatusPropertyInfo = PrintStatus type AttrLabel PrintOperationStatusPropertyInfo = "PrintOperation::status" attrGet _ = getPrintOperationStatus attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "status-string" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable] getPrintOperationStatusString :: (MonadIO m, PrintOperationK o) => o -> m T.Text getPrintOperationStatusString obj = liftIO $ getObjectPropertyString obj "status-string" data PrintOperationStatusStringPropertyInfo instance AttrInfo PrintOperationStatusStringPropertyInfo where type AttrAllowedOps PrintOperationStatusStringPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PrintOperationStatusStringPropertyInfo = (~) () type AttrBaseTypeConstraint PrintOperationStatusStringPropertyInfo = PrintOperationK type AttrGetType PrintOperationStatusStringPropertyInfo = T.Text type AttrLabel PrintOperationStatusStringPropertyInfo = "PrintOperation::status-string" attrGet _ = getPrintOperationStatusString attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "support-selection" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationSupportSelection :: (MonadIO m, PrintOperationK o) => o -> m Bool getPrintOperationSupportSelection obj = liftIO $ getObjectPropertyBool obj "support-selection" setPrintOperationSupportSelection :: (MonadIO m, PrintOperationK o) => o -> Bool -> m () setPrintOperationSupportSelection obj val = liftIO $ setObjectPropertyBool obj "support-selection" val constructPrintOperationSupportSelection :: Bool -> IO ([Char], GValue) constructPrintOperationSupportSelection val = constructObjectPropertyBool "support-selection" val data PrintOperationSupportSelectionPropertyInfo instance AttrInfo PrintOperationSupportSelectionPropertyInfo where type AttrAllowedOps PrintOperationSupportSelectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationSupportSelectionPropertyInfo = (~) Bool type AttrBaseTypeConstraint PrintOperationSupportSelectionPropertyInfo = PrintOperationK type AttrGetType PrintOperationSupportSelectionPropertyInfo = Bool type AttrLabel PrintOperationSupportSelectionPropertyInfo = "PrintOperation::support-selection" attrGet _ = getPrintOperationSupportSelection attrSet _ = setPrintOperationSupportSelection attrConstruct _ = constructPrintOperationSupportSelection -- VVV Prop "track-print-status" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationTrackPrintStatus :: (MonadIO m, PrintOperationK o) => o -> m Bool getPrintOperationTrackPrintStatus obj = liftIO $ getObjectPropertyBool obj "track-print-status" setPrintOperationTrackPrintStatus :: (MonadIO m, PrintOperationK o) => o -> Bool -> m () setPrintOperationTrackPrintStatus obj val = liftIO $ setObjectPropertyBool obj "track-print-status" val constructPrintOperationTrackPrintStatus :: Bool -> IO ([Char], GValue) constructPrintOperationTrackPrintStatus val = constructObjectPropertyBool "track-print-status" val data PrintOperationTrackPrintStatusPropertyInfo instance AttrInfo PrintOperationTrackPrintStatusPropertyInfo where type AttrAllowedOps PrintOperationTrackPrintStatusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationTrackPrintStatusPropertyInfo = (~) Bool type AttrBaseTypeConstraint PrintOperationTrackPrintStatusPropertyInfo = PrintOperationK type AttrGetType PrintOperationTrackPrintStatusPropertyInfo = Bool type AttrLabel PrintOperationTrackPrintStatusPropertyInfo = "PrintOperation::track-print-status" attrGet _ = getPrintOperationTrackPrintStatus attrSet _ = setPrintOperationTrackPrintStatus attrConstruct _ = constructPrintOperationTrackPrintStatus -- VVV Prop "unit" -- Type: TInterface "Gtk" "Unit" -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationUnit :: (MonadIO m, PrintOperationK o) => o -> m Unit getPrintOperationUnit obj = liftIO $ getObjectPropertyEnum obj "unit" setPrintOperationUnit :: (MonadIO m, PrintOperationK o) => o -> Unit -> m () setPrintOperationUnit obj val = liftIO $ setObjectPropertyEnum obj "unit" val constructPrintOperationUnit :: Unit -> IO ([Char], GValue) constructPrintOperationUnit val = constructObjectPropertyEnum "unit" val data PrintOperationUnitPropertyInfo instance AttrInfo PrintOperationUnitPropertyInfo where type AttrAllowedOps PrintOperationUnitPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationUnitPropertyInfo = (~) Unit type AttrBaseTypeConstraint PrintOperationUnitPropertyInfo = PrintOperationK type AttrGetType PrintOperationUnitPropertyInfo = Unit type AttrLabel PrintOperationUnitPropertyInfo = "PrintOperation::unit" attrGet _ = getPrintOperationUnit attrSet _ = setPrintOperationUnit attrConstruct _ = constructPrintOperationUnit -- VVV Prop "use-full-page" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getPrintOperationUseFullPage :: (MonadIO m, PrintOperationK o) => o -> m Bool getPrintOperationUseFullPage obj = liftIO $ getObjectPropertyBool obj "use-full-page" setPrintOperationUseFullPage :: (MonadIO m, PrintOperationK o) => o -> Bool -> m () setPrintOperationUseFullPage obj val = liftIO $ setObjectPropertyBool obj "use-full-page" val constructPrintOperationUseFullPage :: Bool -> IO ([Char], GValue) constructPrintOperationUseFullPage val = constructObjectPropertyBool "use-full-page" val data PrintOperationUseFullPagePropertyInfo instance AttrInfo PrintOperationUseFullPagePropertyInfo where type AttrAllowedOps PrintOperationUseFullPagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PrintOperationUseFullPagePropertyInfo = (~) Bool type AttrBaseTypeConstraint PrintOperationUseFullPagePropertyInfo = PrintOperationK type AttrGetType PrintOperationUseFullPagePropertyInfo = Bool type AttrLabel PrintOperationUseFullPagePropertyInfo = "PrintOperation::use-full-page" attrGet _ = getPrintOperationUseFullPage attrSet _ = setPrintOperationUseFullPage attrConstruct _ = constructPrintOperationUseFullPage type instance AttributeList PrintOperation = '[ '("allow-async", PrintOperationAllowAsyncPropertyInfo), '("current-page", PrintOperationCurrentPagePropertyInfo), '("custom-tab-label", PrintOperationCustomTabLabelPropertyInfo), '("default-page-setup", PrintOperationDefaultPageSetupPropertyInfo), '("embed-page-setup", PrintOperationEmbedPageSetupPropertyInfo), '("export-filename", PrintOperationExportFilenamePropertyInfo), '("has-selection", PrintOperationHasSelectionPropertyInfo), '("job-name", PrintOperationJobNamePropertyInfo), '("n-pages", PrintOperationNPagesPropertyInfo), '("n-pages-to-print", PrintOperationNPagesToPrintPropertyInfo), '("print-settings", PrintOperationPrintSettingsPropertyInfo), '("show-progress", PrintOperationShowProgressPropertyInfo), '("status", PrintOperationStatusPropertyInfo), '("status-string", PrintOperationStatusStringPropertyInfo), '("support-selection", PrintOperationSupportSelectionPropertyInfo), '("track-print-status", PrintOperationTrackPrintStatusPropertyInfo), '("unit", PrintOperationUnitPropertyInfo), '("use-full-page", PrintOperationUseFullPagePropertyInfo)] type instance AttributeList PrintOperationPreview = '[ ] type instance AttributeList PrintSettings = '[ ] -- VVV Prop "ellipsize" -- Type: TInterface "Pango" "EllipsizeMode" -- Flags: [PropertyReadable,PropertyWritable] getProgressBarEllipsize :: (MonadIO m, ProgressBarK o) => o -> m Pango.EllipsizeMode getProgressBarEllipsize obj = liftIO $ getObjectPropertyEnum obj "ellipsize" setProgressBarEllipsize :: (MonadIO m, ProgressBarK o) => o -> Pango.EllipsizeMode -> m () setProgressBarEllipsize obj val = liftIO $ setObjectPropertyEnum obj "ellipsize" val constructProgressBarEllipsize :: Pango.EllipsizeMode -> IO ([Char], GValue) constructProgressBarEllipsize val = constructObjectPropertyEnum "ellipsize" val data ProgressBarEllipsizePropertyInfo instance AttrInfo ProgressBarEllipsizePropertyInfo where type AttrAllowedOps ProgressBarEllipsizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProgressBarEllipsizePropertyInfo = (~) Pango.EllipsizeMode type AttrBaseTypeConstraint ProgressBarEllipsizePropertyInfo = ProgressBarK type AttrGetType ProgressBarEllipsizePropertyInfo = Pango.EllipsizeMode type AttrLabel ProgressBarEllipsizePropertyInfo = "ProgressBar::ellipsize" attrGet _ = getProgressBarEllipsize attrSet _ = setProgressBarEllipsize attrConstruct _ = constructProgressBarEllipsize -- VVV Prop "fraction" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getProgressBarFraction :: (MonadIO m, ProgressBarK o) => o -> m Double getProgressBarFraction obj = liftIO $ getObjectPropertyDouble obj "fraction" setProgressBarFraction :: (MonadIO m, ProgressBarK o) => o -> Double -> m () setProgressBarFraction obj val = liftIO $ setObjectPropertyDouble obj "fraction" val constructProgressBarFraction :: Double -> IO ([Char], GValue) constructProgressBarFraction val = constructObjectPropertyDouble "fraction" val data ProgressBarFractionPropertyInfo instance AttrInfo ProgressBarFractionPropertyInfo where type AttrAllowedOps ProgressBarFractionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProgressBarFractionPropertyInfo = (~) Double type AttrBaseTypeConstraint ProgressBarFractionPropertyInfo = ProgressBarK type AttrGetType ProgressBarFractionPropertyInfo = Double type AttrLabel ProgressBarFractionPropertyInfo = "ProgressBar::fraction" attrGet _ = getProgressBarFraction attrSet _ = setProgressBarFraction attrConstruct _ = constructProgressBarFraction -- VVV Prop "inverted" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getProgressBarInverted :: (MonadIO m, ProgressBarK o) => o -> m Bool getProgressBarInverted obj = liftIO $ getObjectPropertyBool obj "inverted" setProgressBarInverted :: (MonadIO m, ProgressBarK o) => o -> Bool -> m () setProgressBarInverted obj val = liftIO $ setObjectPropertyBool obj "inverted" val constructProgressBarInverted :: Bool -> IO ([Char], GValue) constructProgressBarInverted val = constructObjectPropertyBool "inverted" val data ProgressBarInvertedPropertyInfo instance AttrInfo ProgressBarInvertedPropertyInfo where type AttrAllowedOps ProgressBarInvertedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProgressBarInvertedPropertyInfo = (~) Bool type AttrBaseTypeConstraint ProgressBarInvertedPropertyInfo = ProgressBarK type AttrGetType ProgressBarInvertedPropertyInfo = Bool type AttrLabel ProgressBarInvertedPropertyInfo = "ProgressBar::inverted" attrGet _ = getProgressBarInverted attrSet _ = setProgressBarInverted attrConstruct _ = constructProgressBarInverted -- VVV Prop "pulse-step" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getProgressBarPulseStep :: (MonadIO m, ProgressBarK o) => o -> m Double getProgressBarPulseStep obj = liftIO $ getObjectPropertyDouble obj "pulse-step" setProgressBarPulseStep :: (MonadIO m, ProgressBarK o) => o -> Double -> m () setProgressBarPulseStep obj val = liftIO $ setObjectPropertyDouble obj "pulse-step" val constructProgressBarPulseStep :: Double -> IO ([Char], GValue) constructProgressBarPulseStep val = constructObjectPropertyDouble "pulse-step" val data ProgressBarPulseStepPropertyInfo instance AttrInfo ProgressBarPulseStepPropertyInfo where type AttrAllowedOps ProgressBarPulseStepPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProgressBarPulseStepPropertyInfo = (~) Double type AttrBaseTypeConstraint ProgressBarPulseStepPropertyInfo = ProgressBarK type AttrGetType ProgressBarPulseStepPropertyInfo = Double type AttrLabel ProgressBarPulseStepPropertyInfo = "ProgressBar::pulse-step" attrGet _ = getProgressBarPulseStep attrSet _ = setProgressBarPulseStep attrConstruct _ = constructProgressBarPulseStep -- VVV Prop "show-text" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getProgressBarShowText :: (MonadIO m, ProgressBarK o) => o -> m Bool getProgressBarShowText obj = liftIO $ getObjectPropertyBool obj "show-text" setProgressBarShowText :: (MonadIO m, ProgressBarK o) => o -> Bool -> m () setProgressBarShowText obj val = liftIO $ setObjectPropertyBool obj "show-text" val constructProgressBarShowText :: Bool -> IO ([Char], GValue) constructProgressBarShowText val = constructObjectPropertyBool "show-text" val data ProgressBarShowTextPropertyInfo instance AttrInfo ProgressBarShowTextPropertyInfo where type AttrAllowedOps ProgressBarShowTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProgressBarShowTextPropertyInfo = (~) Bool type AttrBaseTypeConstraint ProgressBarShowTextPropertyInfo = ProgressBarK type AttrGetType ProgressBarShowTextPropertyInfo = Bool type AttrLabel ProgressBarShowTextPropertyInfo = "ProgressBar::show-text" attrGet _ = getProgressBarShowText attrSet _ = setProgressBarShowText attrConstruct _ = constructProgressBarShowText -- VVV Prop "text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getProgressBarText :: (MonadIO m, ProgressBarK o) => o -> m T.Text getProgressBarText obj = liftIO $ getObjectPropertyString obj "text" setProgressBarText :: (MonadIO m, ProgressBarK o) => o -> T.Text -> m () setProgressBarText obj val = liftIO $ setObjectPropertyString obj "text" val constructProgressBarText :: T.Text -> IO ([Char], GValue) constructProgressBarText val = constructObjectPropertyString "text" val data ProgressBarTextPropertyInfo instance AttrInfo ProgressBarTextPropertyInfo where type AttrAllowedOps ProgressBarTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProgressBarTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ProgressBarTextPropertyInfo = ProgressBarK type AttrGetType ProgressBarTextPropertyInfo = T.Text type AttrLabel ProgressBarTextPropertyInfo = "ProgressBar::text" attrGet _ = getProgressBarText attrSet _ = setProgressBarText attrConstruct _ = constructProgressBarText type instance AttributeList ProgressBar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("ellipsize", ProgressBarEllipsizePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("fraction", ProgressBarFractionPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inverted", ProgressBarInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("pulse-step", ProgressBarPulseStepPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-text", ProgressBarShowTextPropertyInfo), '("style", WidgetStylePropertyInfo), '("text", ProgressBarTextPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList ProgressBarAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "current-value" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getRadioActionCurrentValue :: (MonadIO m, RadioActionK o) => o -> m Int32 getRadioActionCurrentValue obj = liftIO $ getObjectPropertyCInt obj "current-value" setRadioActionCurrentValue :: (MonadIO m, RadioActionK o) => o -> Int32 -> m () setRadioActionCurrentValue obj val = liftIO $ setObjectPropertyCInt obj "current-value" val constructRadioActionCurrentValue :: Int32 -> IO ([Char], GValue) constructRadioActionCurrentValue val = constructObjectPropertyCInt "current-value" val data RadioActionCurrentValuePropertyInfo instance AttrInfo RadioActionCurrentValuePropertyInfo where type AttrAllowedOps RadioActionCurrentValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RadioActionCurrentValuePropertyInfo = (~) Int32 type AttrBaseTypeConstraint RadioActionCurrentValuePropertyInfo = RadioActionK type AttrGetType RadioActionCurrentValuePropertyInfo = Int32 type AttrLabel RadioActionCurrentValuePropertyInfo = "RadioAction::current-value" attrGet _ = getRadioActionCurrentValue attrSet _ = setRadioActionCurrentValue attrConstruct _ = constructRadioActionCurrentValue -- VVV Prop "group" -- Type: TInterface "Gtk" "RadioAction" -- Flags: [PropertyWritable] setRadioActionGroup :: (MonadIO m, RadioActionK o, RadioActionK a) => o -> a -> m () setRadioActionGroup obj val = liftIO $ setObjectPropertyObject obj "group" val constructRadioActionGroup :: (RadioActionK a) => a -> IO ([Char], GValue) constructRadioActionGroup val = constructObjectPropertyObject "group" val data RadioActionGroupPropertyInfo instance AttrInfo RadioActionGroupPropertyInfo where type AttrAllowedOps RadioActionGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint RadioActionGroupPropertyInfo = RadioActionK type AttrBaseTypeConstraint RadioActionGroupPropertyInfo = RadioActionK type AttrGetType RadioActionGroupPropertyInfo = () type AttrLabel RadioActionGroupPropertyInfo = "RadioAction::group" attrGet _ = undefined attrSet _ = setRadioActionGroup attrConstruct _ = constructRadioActionGroup -- VVV Prop "value" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getRadioActionValue :: (MonadIO m, RadioActionK o) => o -> m Int32 getRadioActionValue obj = liftIO $ getObjectPropertyCInt obj "value" setRadioActionValue :: (MonadIO m, RadioActionK o) => o -> Int32 -> m () setRadioActionValue obj val = liftIO $ setObjectPropertyCInt obj "value" val constructRadioActionValue :: Int32 -> IO ([Char], GValue) constructRadioActionValue val = constructObjectPropertyCInt "value" val data RadioActionValuePropertyInfo instance AttrInfo RadioActionValuePropertyInfo where type AttrAllowedOps RadioActionValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RadioActionValuePropertyInfo = (~) Int32 type AttrBaseTypeConstraint RadioActionValuePropertyInfo = RadioActionK type AttrGetType RadioActionValuePropertyInfo = Int32 type AttrLabel RadioActionValuePropertyInfo = "RadioAction::value" attrGet _ = getRadioActionValue attrSet _ = setRadioActionValue attrConstruct _ = constructRadioActionValue type instance AttributeList RadioAction = '[ '("action-group", ActionActionGroupPropertyInfo), '("active", ToggleActionActivePropertyInfo), '("always-show-image", ActionAlwaysShowImagePropertyInfo), '("current-value", RadioActionCurrentValuePropertyInfo), '("draw-as-radio", ToggleActionDrawAsRadioPropertyInfo), '("gicon", ActionGiconPropertyInfo), '("group", RadioActionGroupPropertyInfo), '("hide-if-empty", ActionHideIfEmptyPropertyInfo), '("icon-name", ActionIconNamePropertyInfo), '("is-important", ActionIsImportantPropertyInfo), '("label", ActionLabelPropertyInfo), '("name", ActionNamePropertyInfo), '("sensitive", ActionSensitivePropertyInfo), '("short-label", ActionShortLabelPropertyInfo), '("stock-id", ActionStockIdPropertyInfo), '("tooltip", ActionTooltipPropertyInfo), '("value", RadioActionValuePropertyInfo), '("visible", ActionVisiblePropertyInfo), '("visible-horizontal", ActionVisibleHorizontalPropertyInfo), '("visible-overflown", ActionVisibleOverflownPropertyInfo), '("visible-vertical", ActionVisibleVerticalPropertyInfo)] -- VVV Prop "group" -- Type: TInterface "Gtk" "RadioButton" -- Flags: [PropertyWritable] setRadioButtonGroup :: (MonadIO m, RadioButtonK o, RadioButtonK a) => o -> a -> m () setRadioButtonGroup obj val = liftIO $ setObjectPropertyObject obj "group" val constructRadioButtonGroup :: (RadioButtonK a) => a -> IO ([Char], GValue) constructRadioButtonGroup val = constructObjectPropertyObject "group" val data RadioButtonGroupPropertyInfo instance AttrInfo RadioButtonGroupPropertyInfo where type AttrAllowedOps RadioButtonGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint RadioButtonGroupPropertyInfo = RadioButtonK type AttrBaseTypeConstraint RadioButtonGroupPropertyInfo = RadioButtonK type AttrGetType RadioButtonGroupPropertyInfo = () type AttrLabel RadioButtonGroupPropertyInfo = "RadioButton::group" attrGet _ = undefined attrSet _ = setRadioButtonGroup attrConstruct _ = constructRadioButtonGroup type instance AttributeList RadioButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("active", ToggleButtonActivePropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-indicator", ToggleButtonDrawIndicatorPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("group", RadioButtonGroupPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("inconsistent", ToggleButtonInconsistentPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] type instance AttributeList RadioButtonAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "group" -- Type: TInterface "Gtk" "RadioMenuItem" -- Flags: [PropertyWritable] setRadioMenuItemGroup :: (MonadIO m, RadioMenuItemK o, RadioMenuItemK a) => o -> a -> m () setRadioMenuItemGroup obj val = liftIO $ setObjectPropertyObject obj "group" val constructRadioMenuItemGroup :: (RadioMenuItemK a) => a -> IO ([Char], GValue) constructRadioMenuItemGroup val = constructObjectPropertyObject "group" val data RadioMenuItemGroupPropertyInfo instance AttrInfo RadioMenuItemGroupPropertyInfo where type AttrAllowedOps RadioMenuItemGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint RadioMenuItemGroupPropertyInfo = RadioMenuItemK type AttrBaseTypeConstraint RadioMenuItemGroupPropertyInfo = RadioMenuItemK type AttrGetType RadioMenuItemGroupPropertyInfo = () type AttrLabel RadioMenuItemGroupPropertyInfo = "RadioMenuItem::group" attrGet _ = undefined attrSet _ = setRadioMenuItemGroup attrConstruct _ = constructRadioMenuItemGroup type instance AttributeList RadioMenuItem = '[ '("accel-path", MenuItemAccelPathPropertyInfo), '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("active", CheckMenuItemActivePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-as-radio", CheckMenuItemDrawAsRadioPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("group", RadioMenuItemGroupPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inconsistent", CheckMenuItemInconsistentPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", MenuItemLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("right-justified", MenuItemRightJustifiedPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("submenu", MenuItemSubmenuPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-underline", MenuItemUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList RadioMenuItemAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "group" -- Type: TInterface "Gtk" "RadioToolButton" -- Flags: [PropertyWritable] setRadioToolButtonGroup :: (MonadIO m, RadioToolButtonK o, RadioToolButtonK a) => o -> a -> m () setRadioToolButtonGroup obj val = liftIO $ setObjectPropertyObject obj "group" val constructRadioToolButtonGroup :: (RadioToolButtonK a) => a -> IO ([Char], GValue) constructRadioToolButtonGroup val = constructObjectPropertyObject "group" val data RadioToolButtonGroupPropertyInfo instance AttrInfo RadioToolButtonGroupPropertyInfo where type AttrAllowedOps RadioToolButtonGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint RadioToolButtonGroupPropertyInfo = RadioToolButtonK type AttrBaseTypeConstraint RadioToolButtonGroupPropertyInfo = RadioToolButtonK type AttrGetType RadioToolButtonGroupPropertyInfo = () type AttrLabel RadioToolButtonGroupPropertyInfo = "RadioToolButton::group" attrGet _ = undefined attrSet _ = setRadioToolButtonGroup attrConstruct _ = constructRadioToolButtonGroup type instance AttributeList RadioToolButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("active", ToggleToolButtonActivePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("group", RadioToolButtonGroupPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("icon-name", ToolButtonIconNamePropertyInfo), '("icon-widget", ToolButtonIconWidgetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-important", ToolItemIsImportantPropertyInfo), '("label", ToolButtonLabelPropertyInfo), '("label-widget", ToolButtonLabelWidgetPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("stock-id", ToolButtonStockIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-underline", ToolButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("visible-horizontal", ToolItemVisibleHorizontalPropertyInfo), '("visible-vertical", ToolItemVisibleVerticalPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "adjustment" -- Type: TInterface "Gtk" "Adjustment" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getRangeAdjustment :: (MonadIO m, RangeK o) => o -> m Adjustment getRangeAdjustment obj = liftIO $ getObjectPropertyObject obj "adjustment" Adjustment setRangeAdjustment :: (MonadIO m, RangeK o, AdjustmentK a) => o -> a -> m () setRangeAdjustment obj val = liftIO $ setObjectPropertyObject obj "adjustment" val constructRangeAdjustment :: (AdjustmentK a) => a -> IO ([Char], GValue) constructRangeAdjustment val = constructObjectPropertyObject "adjustment" val data RangeAdjustmentPropertyInfo instance AttrInfo RangeAdjustmentPropertyInfo where type AttrAllowedOps RangeAdjustmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RangeAdjustmentPropertyInfo = AdjustmentK type AttrBaseTypeConstraint RangeAdjustmentPropertyInfo = RangeK type AttrGetType RangeAdjustmentPropertyInfo = Adjustment type AttrLabel RangeAdjustmentPropertyInfo = "Range::adjustment" attrGet _ = getRangeAdjustment attrSet _ = setRangeAdjustment attrConstruct _ = constructRangeAdjustment -- VVV Prop "fill-level" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getRangeFillLevel :: (MonadIO m, RangeK o) => o -> m Double getRangeFillLevel obj = liftIO $ getObjectPropertyDouble obj "fill-level" setRangeFillLevel :: (MonadIO m, RangeK o) => o -> Double -> m () setRangeFillLevel obj val = liftIO $ setObjectPropertyDouble obj "fill-level" val constructRangeFillLevel :: Double -> IO ([Char], GValue) constructRangeFillLevel val = constructObjectPropertyDouble "fill-level" val data RangeFillLevelPropertyInfo instance AttrInfo RangeFillLevelPropertyInfo where type AttrAllowedOps RangeFillLevelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RangeFillLevelPropertyInfo = (~) Double type AttrBaseTypeConstraint RangeFillLevelPropertyInfo = RangeK type AttrGetType RangeFillLevelPropertyInfo = Double type AttrLabel RangeFillLevelPropertyInfo = "Range::fill-level" attrGet _ = getRangeFillLevel attrSet _ = setRangeFillLevel attrConstruct _ = constructRangeFillLevel -- VVV Prop "inverted" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRangeInverted :: (MonadIO m, RangeK o) => o -> m Bool getRangeInverted obj = liftIO $ getObjectPropertyBool obj "inverted" setRangeInverted :: (MonadIO m, RangeK o) => o -> Bool -> m () setRangeInverted obj val = liftIO $ setObjectPropertyBool obj "inverted" val constructRangeInverted :: Bool -> IO ([Char], GValue) constructRangeInverted val = constructObjectPropertyBool "inverted" val data RangeInvertedPropertyInfo instance AttrInfo RangeInvertedPropertyInfo where type AttrAllowedOps RangeInvertedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RangeInvertedPropertyInfo = (~) Bool type AttrBaseTypeConstraint RangeInvertedPropertyInfo = RangeK type AttrGetType RangeInvertedPropertyInfo = Bool type AttrLabel RangeInvertedPropertyInfo = "Range::inverted" attrGet _ = getRangeInverted attrSet _ = setRangeInverted attrConstruct _ = constructRangeInverted -- VVV Prop "lower-stepper-sensitivity" -- Type: TInterface "Gtk" "SensitivityType" -- Flags: [PropertyReadable,PropertyWritable] getRangeLowerStepperSensitivity :: (MonadIO m, RangeK o) => o -> m SensitivityType getRangeLowerStepperSensitivity obj = liftIO $ getObjectPropertyEnum obj "lower-stepper-sensitivity" setRangeLowerStepperSensitivity :: (MonadIO m, RangeK o) => o -> SensitivityType -> m () setRangeLowerStepperSensitivity obj val = liftIO $ setObjectPropertyEnum obj "lower-stepper-sensitivity" val constructRangeLowerStepperSensitivity :: SensitivityType -> IO ([Char], GValue) constructRangeLowerStepperSensitivity val = constructObjectPropertyEnum "lower-stepper-sensitivity" val data RangeLowerStepperSensitivityPropertyInfo instance AttrInfo RangeLowerStepperSensitivityPropertyInfo where type AttrAllowedOps RangeLowerStepperSensitivityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RangeLowerStepperSensitivityPropertyInfo = (~) SensitivityType type AttrBaseTypeConstraint RangeLowerStepperSensitivityPropertyInfo = RangeK type AttrGetType RangeLowerStepperSensitivityPropertyInfo = SensitivityType type AttrLabel RangeLowerStepperSensitivityPropertyInfo = "Range::lower-stepper-sensitivity" attrGet _ = getRangeLowerStepperSensitivity attrSet _ = setRangeLowerStepperSensitivity attrConstruct _ = constructRangeLowerStepperSensitivity -- VVV Prop "restrict-to-fill-level" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRangeRestrictToFillLevel :: (MonadIO m, RangeK o) => o -> m Bool getRangeRestrictToFillLevel obj = liftIO $ getObjectPropertyBool obj "restrict-to-fill-level" setRangeRestrictToFillLevel :: (MonadIO m, RangeK o) => o -> Bool -> m () setRangeRestrictToFillLevel obj val = liftIO $ setObjectPropertyBool obj "restrict-to-fill-level" val constructRangeRestrictToFillLevel :: Bool -> IO ([Char], GValue) constructRangeRestrictToFillLevel val = constructObjectPropertyBool "restrict-to-fill-level" val data RangeRestrictToFillLevelPropertyInfo instance AttrInfo RangeRestrictToFillLevelPropertyInfo where type AttrAllowedOps RangeRestrictToFillLevelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RangeRestrictToFillLevelPropertyInfo = (~) Bool type AttrBaseTypeConstraint RangeRestrictToFillLevelPropertyInfo = RangeK type AttrGetType RangeRestrictToFillLevelPropertyInfo = Bool type AttrLabel RangeRestrictToFillLevelPropertyInfo = "Range::restrict-to-fill-level" attrGet _ = getRangeRestrictToFillLevel attrSet _ = setRangeRestrictToFillLevel attrConstruct _ = constructRangeRestrictToFillLevel -- VVV Prop "round-digits" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getRangeRoundDigits :: (MonadIO m, RangeK o) => o -> m Int32 getRangeRoundDigits obj = liftIO $ getObjectPropertyCInt obj "round-digits" setRangeRoundDigits :: (MonadIO m, RangeK o) => o -> Int32 -> m () setRangeRoundDigits obj val = liftIO $ setObjectPropertyCInt obj "round-digits" val constructRangeRoundDigits :: Int32 -> IO ([Char], GValue) constructRangeRoundDigits val = constructObjectPropertyCInt "round-digits" val data RangeRoundDigitsPropertyInfo instance AttrInfo RangeRoundDigitsPropertyInfo where type AttrAllowedOps RangeRoundDigitsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RangeRoundDigitsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint RangeRoundDigitsPropertyInfo = RangeK type AttrGetType RangeRoundDigitsPropertyInfo = Int32 type AttrLabel RangeRoundDigitsPropertyInfo = "Range::round-digits" attrGet _ = getRangeRoundDigits attrSet _ = setRangeRoundDigits attrConstruct _ = constructRangeRoundDigits -- VVV Prop "show-fill-level" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRangeShowFillLevel :: (MonadIO m, RangeK o) => o -> m Bool getRangeShowFillLevel obj = liftIO $ getObjectPropertyBool obj "show-fill-level" setRangeShowFillLevel :: (MonadIO m, RangeK o) => o -> Bool -> m () setRangeShowFillLevel obj val = liftIO $ setObjectPropertyBool obj "show-fill-level" val constructRangeShowFillLevel :: Bool -> IO ([Char], GValue) constructRangeShowFillLevel val = constructObjectPropertyBool "show-fill-level" val data RangeShowFillLevelPropertyInfo instance AttrInfo RangeShowFillLevelPropertyInfo where type AttrAllowedOps RangeShowFillLevelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RangeShowFillLevelPropertyInfo = (~) Bool type AttrBaseTypeConstraint RangeShowFillLevelPropertyInfo = RangeK type AttrGetType RangeShowFillLevelPropertyInfo = Bool type AttrLabel RangeShowFillLevelPropertyInfo = "Range::show-fill-level" attrGet _ = getRangeShowFillLevel attrSet _ = setRangeShowFillLevel attrConstruct _ = constructRangeShowFillLevel -- VVV Prop "upper-stepper-sensitivity" -- Type: TInterface "Gtk" "SensitivityType" -- Flags: [PropertyReadable,PropertyWritable] getRangeUpperStepperSensitivity :: (MonadIO m, RangeK o) => o -> m SensitivityType getRangeUpperStepperSensitivity obj = liftIO $ getObjectPropertyEnum obj "upper-stepper-sensitivity" setRangeUpperStepperSensitivity :: (MonadIO m, RangeK o) => o -> SensitivityType -> m () setRangeUpperStepperSensitivity obj val = liftIO $ setObjectPropertyEnum obj "upper-stepper-sensitivity" val constructRangeUpperStepperSensitivity :: SensitivityType -> IO ([Char], GValue) constructRangeUpperStepperSensitivity val = constructObjectPropertyEnum "upper-stepper-sensitivity" val data RangeUpperStepperSensitivityPropertyInfo instance AttrInfo RangeUpperStepperSensitivityPropertyInfo where type AttrAllowedOps RangeUpperStepperSensitivityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RangeUpperStepperSensitivityPropertyInfo = (~) SensitivityType type AttrBaseTypeConstraint RangeUpperStepperSensitivityPropertyInfo = RangeK type AttrGetType RangeUpperStepperSensitivityPropertyInfo = SensitivityType type AttrLabel RangeUpperStepperSensitivityPropertyInfo = "Range::upper-stepper-sensitivity" attrGet _ = getRangeUpperStepperSensitivity attrSet _ = setRangeUpperStepperSensitivity attrConstruct _ = constructRangeUpperStepperSensitivity type instance AttributeList Range = '[ '("adjustment", RangeAdjustmentPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("fill-level", RangeFillLevelPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inverted", RangeInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("lower-stepper-sensitivity", RangeLowerStepperSensitivityPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("restrict-to-fill-level", RangeRestrictToFillLevelPropertyInfo), '("round-digits", RangeRoundDigitsPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-fill-level", RangeShowFillLevelPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("upper-stepper-sensitivity", RangeUpperStepperSensitivityPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList RangeAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList RcStyle = '[ ] -- VVV Prop "show-numbers" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRecentActionShowNumbers :: (MonadIO m, RecentActionK o) => o -> m Bool getRecentActionShowNumbers obj = liftIO $ getObjectPropertyBool obj "show-numbers" setRecentActionShowNumbers :: (MonadIO m, RecentActionK o) => o -> Bool -> m () setRecentActionShowNumbers obj val = liftIO $ setObjectPropertyBool obj "show-numbers" val constructRecentActionShowNumbers :: Bool -> IO ([Char], GValue) constructRecentActionShowNumbers val = constructObjectPropertyBool "show-numbers" val data RecentActionShowNumbersPropertyInfo instance AttrInfo RecentActionShowNumbersPropertyInfo where type AttrAllowedOps RecentActionShowNumbersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentActionShowNumbersPropertyInfo = (~) Bool type AttrBaseTypeConstraint RecentActionShowNumbersPropertyInfo = RecentActionK type AttrGetType RecentActionShowNumbersPropertyInfo = Bool type AttrLabel RecentActionShowNumbersPropertyInfo = "RecentAction::show-numbers" attrGet _ = getRecentActionShowNumbers attrSet _ = setRecentActionShowNumbers attrConstruct _ = constructRecentActionShowNumbers type instance AttributeList RecentAction = '[ '("action-group", ActionActionGroupPropertyInfo), '("always-show-image", ActionAlwaysShowImagePropertyInfo), '("filter", RecentChooserFilterPropertyInfo), '("gicon", ActionGiconPropertyInfo), '("hide-if-empty", ActionHideIfEmptyPropertyInfo), '("icon-name", ActionIconNamePropertyInfo), '("is-important", ActionIsImportantPropertyInfo), '("label", ActionLabelPropertyInfo), '("limit", RecentChooserLimitPropertyInfo), '("local-only", RecentChooserLocalOnlyPropertyInfo), '("name", ActionNamePropertyInfo), '("recent-manager", RecentChooserRecentManagerPropertyInfo), '("select-multiple", RecentChooserSelectMultiplePropertyInfo), '("sensitive", ActionSensitivePropertyInfo), '("short-label", ActionShortLabelPropertyInfo), '("show-icons", RecentChooserShowIconsPropertyInfo), '("show-not-found", RecentChooserShowNotFoundPropertyInfo), '("show-numbers", RecentActionShowNumbersPropertyInfo), '("show-private", RecentChooserShowPrivatePropertyInfo), '("show-tips", RecentChooserShowTipsPropertyInfo), '("sort-type", RecentChooserSortTypePropertyInfo), '("stock-id", ActionStockIdPropertyInfo), '("tooltip", ActionTooltipPropertyInfo), '("visible", ActionVisiblePropertyInfo), '("visible-horizontal", ActionVisibleHorizontalPropertyInfo), '("visible-overflown", ActionVisibleOverflownPropertyInfo), '("visible-vertical", ActionVisibleVerticalPropertyInfo)] -- VVV Prop "filter" -- Type: TInterface "Gtk" "RecentFilter" -- Flags: [PropertyReadable,PropertyWritable] getRecentChooserFilter :: (MonadIO m, RecentChooserK o) => o -> m RecentFilter getRecentChooserFilter obj = liftIO $ getObjectPropertyObject obj "filter" RecentFilter setRecentChooserFilter :: (MonadIO m, RecentChooserK o, RecentFilterK a) => o -> a -> m () setRecentChooserFilter obj val = liftIO $ setObjectPropertyObject obj "filter" val constructRecentChooserFilter :: (RecentFilterK a) => a -> IO ([Char], GValue) constructRecentChooserFilter val = constructObjectPropertyObject "filter" val data RecentChooserFilterPropertyInfo instance AttrInfo RecentChooserFilterPropertyInfo where type AttrAllowedOps RecentChooserFilterPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentChooserFilterPropertyInfo = RecentFilterK type AttrBaseTypeConstraint RecentChooserFilterPropertyInfo = RecentChooserK type AttrGetType RecentChooserFilterPropertyInfo = RecentFilter type AttrLabel RecentChooserFilterPropertyInfo = "RecentChooser::filter" attrGet _ = getRecentChooserFilter attrSet _ = setRecentChooserFilter attrConstruct _ = constructRecentChooserFilter -- VVV Prop "limit" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getRecentChooserLimit :: (MonadIO m, RecentChooserK o) => o -> m Int32 getRecentChooserLimit obj = liftIO $ getObjectPropertyCInt obj "limit" setRecentChooserLimit :: (MonadIO m, RecentChooserK o) => o -> Int32 -> m () setRecentChooserLimit obj val = liftIO $ setObjectPropertyCInt obj "limit" val constructRecentChooserLimit :: Int32 -> IO ([Char], GValue) constructRecentChooserLimit val = constructObjectPropertyCInt "limit" val data RecentChooserLimitPropertyInfo instance AttrInfo RecentChooserLimitPropertyInfo where type AttrAllowedOps RecentChooserLimitPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentChooserLimitPropertyInfo = (~) Int32 type AttrBaseTypeConstraint RecentChooserLimitPropertyInfo = RecentChooserK type AttrGetType RecentChooserLimitPropertyInfo = Int32 type AttrLabel RecentChooserLimitPropertyInfo = "RecentChooser::limit" attrGet _ = getRecentChooserLimit attrSet _ = setRecentChooserLimit attrConstruct _ = constructRecentChooserLimit -- VVV Prop "local-only" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRecentChooserLocalOnly :: (MonadIO m, RecentChooserK o) => o -> m Bool getRecentChooserLocalOnly obj = liftIO $ getObjectPropertyBool obj "local-only" setRecentChooserLocalOnly :: (MonadIO m, RecentChooserK o) => o -> Bool -> m () setRecentChooserLocalOnly obj val = liftIO $ setObjectPropertyBool obj "local-only" val constructRecentChooserLocalOnly :: Bool -> IO ([Char], GValue) constructRecentChooserLocalOnly val = constructObjectPropertyBool "local-only" val data RecentChooserLocalOnlyPropertyInfo instance AttrInfo RecentChooserLocalOnlyPropertyInfo where type AttrAllowedOps RecentChooserLocalOnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentChooserLocalOnlyPropertyInfo = (~) Bool type AttrBaseTypeConstraint RecentChooserLocalOnlyPropertyInfo = RecentChooserK type AttrGetType RecentChooserLocalOnlyPropertyInfo = Bool type AttrLabel RecentChooserLocalOnlyPropertyInfo = "RecentChooser::local-only" attrGet _ = getRecentChooserLocalOnly attrSet _ = setRecentChooserLocalOnly attrConstruct _ = constructRecentChooserLocalOnly -- VVV Prop "recent-manager" -- Type: TInterface "Gtk" "RecentManager" -- Flags: [PropertyWritable,PropertyConstructOnly] constructRecentChooserRecentManager :: (RecentManagerK a) => a -> IO ([Char], GValue) constructRecentChooserRecentManager val = constructObjectPropertyObject "recent-manager" val data RecentChooserRecentManagerPropertyInfo instance AttrInfo RecentChooserRecentManagerPropertyInfo where type AttrAllowedOps RecentChooserRecentManagerPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint RecentChooserRecentManagerPropertyInfo = RecentManagerK type AttrBaseTypeConstraint RecentChooserRecentManagerPropertyInfo = RecentChooserK type AttrGetType RecentChooserRecentManagerPropertyInfo = () type AttrLabel RecentChooserRecentManagerPropertyInfo = "RecentChooser::recent-manager" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructRecentChooserRecentManager -- VVV Prop "select-multiple" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRecentChooserSelectMultiple :: (MonadIO m, RecentChooserK o) => o -> m Bool getRecentChooserSelectMultiple obj = liftIO $ getObjectPropertyBool obj "select-multiple" setRecentChooserSelectMultiple :: (MonadIO m, RecentChooserK o) => o -> Bool -> m () setRecentChooserSelectMultiple obj val = liftIO $ setObjectPropertyBool obj "select-multiple" val constructRecentChooserSelectMultiple :: Bool -> IO ([Char], GValue) constructRecentChooserSelectMultiple val = constructObjectPropertyBool "select-multiple" val data RecentChooserSelectMultiplePropertyInfo instance AttrInfo RecentChooserSelectMultiplePropertyInfo where type AttrAllowedOps RecentChooserSelectMultiplePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentChooserSelectMultiplePropertyInfo = (~) Bool type AttrBaseTypeConstraint RecentChooserSelectMultiplePropertyInfo = RecentChooserK type AttrGetType RecentChooserSelectMultiplePropertyInfo = Bool type AttrLabel RecentChooserSelectMultiplePropertyInfo = "RecentChooser::select-multiple" attrGet _ = getRecentChooserSelectMultiple attrSet _ = setRecentChooserSelectMultiple attrConstruct _ = constructRecentChooserSelectMultiple -- VVV Prop "show-icons" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRecentChooserShowIcons :: (MonadIO m, RecentChooserK o) => o -> m Bool getRecentChooserShowIcons obj = liftIO $ getObjectPropertyBool obj "show-icons" setRecentChooserShowIcons :: (MonadIO m, RecentChooserK o) => o -> Bool -> m () setRecentChooserShowIcons obj val = liftIO $ setObjectPropertyBool obj "show-icons" val constructRecentChooserShowIcons :: Bool -> IO ([Char], GValue) constructRecentChooserShowIcons val = constructObjectPropertyBool "show-icons" val data RecentChooserShowIconsPropertyInfo instance AttrInfo RecentChooserShowIconsPropertyInfo where type AttrAllowedOps RecentChooserShowIconsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentChooserShowIconsPropertyInfo = (~) Bool type AttrBaseTypeConstraint RecentChooserShowIconsPropertyInfo = RecentChooserK type AttrGetType RecentChooserShowIconsPropertyInfo = Bool type AttrLabel RecentChooserShowIconsPropertyInfo = "RecentChooser::show-icons" attrGet _ = getRecentChooserShowIcons attrSet _ = setRecentChooserShowIcons attrConstruct _ = constructRecentChooserShowIcons -- VVV Prop "show-not-found" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRecentChooserShowNotFound :: (MonadIO m, RecentChooserK o) => o -> m Bool getRecentChooserShowNotFound obj = liftIO $ getObjectPropertyBool obj "show-not-found" setRecentChooserShowNotFound :: (MonadIO m, RecentChooserK o) => o -> Bool -> m () setRecentChooserShowNotFound obj val = liftIO $ setObjectPropertyBool obj "show-not-found" val constructRecentChooserShowNotFound :: Bool -> IO ([Char], GValue) constructRecentChooserShowNotFound val = constructObjectPropertyBool "show-not-found" val data RecentChooserShowNotFoundPropertyInfo instance AttrInfo RecentChooserShowNotFoundPropertyInfo where type AttrAllowedOps RecentChooserShowNotFoundPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentChooserShowNotFoundPropertyInfo = (~) Bool type AttrBaseTypeConstraint RecentChooserShowNotFoundPropertyInfo = RecentChooserK type AttrGetType RecentChooserShowNotFoundPropertyInfo = Bool type AttrLabel RecentChooserShowNotFoundPropertyInfo = "RecentChooser::show-not-found" attrGet _ = getRecentChooserShowNotFound attrSet _ = setRecentChooserShowNotFound attrConstruct _ = constructRecentChooserShowNotFound -- VVV Prop "show-private" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRecentChooserShowPrivate :: (MonadIO m, RecentChooserK o) => o -> m Bool getRecentChooserShowPrivate obj = liftIO $ getObjectPropertyBool obj "show-private" setRecentChooserShowPrivate :: (MonadIO m, RecentChooserK o) => o -> Bool -> m () setRecentChooserShowPrivate obj val = liftIO $ setObjectPropertyBool obj "show-private" val constructRecentChooserShowPrivate :: Bool -> IO ([Char], GValue) constructRecentChooserShowPrivate val = constructObjectPropertyBool "show-private" val data RecentChooserShowPrivatePropertyInfo instance AttrInfo RecentChooserShowPrivatePropertyInfo where type AttrAllowedOps RecentChooserShowPrivatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentChooserShowPrivatePropertyInfo = (~) Bool type AttrBaseTypeConstraint RecentChooserShowPrivatePropertyInfo = RecentChooserK type AttrGetType RecentChooserShowPrivatePropertyInfo = Bool type AttrLabel RecentChooserShowPrivatePropertyInfo = "RecentChooser::show-private" attrGet _ = getRecentChooserShowPrivate attrSet _ = setRecentChooserShowPrivate attrConstruct _ = constructRecentChooserShowPrivate -- VVV Prop "show-tips" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRecentChooserShowTips :: (MonadIO m, RecentChooserK o) => o -> m Bool getRecentChooserShowTips obj = liftIO $ getObjectPropertyBool obj "show-tips" setRecentChooserShowTips :: (MonadIO m, RecentChooserK o) => o -> Bool -> m () setRecentChooserShowTips obj val = liftIO $ setObjectPropertyBool obj "show-tips" val constructRecentChooserShowTips :: Bool -> IO ([Char], GValue) constructRecentChooserShowTips val = constructObjectPropertyBool "show-tips" val data RecentChooserShowTipsPropertyInfo instance AttrInfo RecentChooserShowTipsPropertyInfo where type AttrAllowedOps RecentChooserShowTipsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentChooserShowTipsPropertyInfo = (~) Bool type AttrBaseTypeConstraint RecentChooserShowTipsPropertyInfo = RecentChooserK type AttrGetType RecentChooserShowTipsPropertyInfo = Bool type AttrLabel RecentChooserShowTipsPropertyInfo = "RecentChooser::show-tips" attrGet _ = getRecentChooserShowTips attrSet _ = setRecentChooserShowTips attrConstruct _ = constructRecentChooserShowTips -- VVV Prop "sort-type" -- Type: TInterface "Gtk" "RecentSortType" -- Flags: [PropertyReadable,PropertyWritable] getRecentChooserSortType :: (MonadIO m, RecentChooserK o) => o -> m RecentSortType getRecentChooserSortType obj = liftIO $ getObjectPropertyEnum obj "sort-type" setRecentChooserSortType :: (MonadIO m, RecentChooserK o) => o -> RecentSortType -> m () setRecentChooserSortType obj val = liftIO $ setObjectPropertyEnum obj "sort-type" val constructRecentChooserSortType :: RecentSortType -> IO ([Char], GValue) constructRecentChooserSortType val = constructObjectPropertyEnum "sort-type" val data RecentChooserSortTypePropertyInfo instance AttrInfo RecentChooserSortTypePropertyInfo where type AttrAllowedOps RecentChooserSortTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentChooserSortTypePropertyInfo = (~) RecentSortType type AttrBaseTypeConstraint RecentChooserSortTypePropertyInfo = RecentChooserK type AttrGetType RecentChooserSortTypePropertyInfo = RecentSortType type AttrLabel RecentChooserSortTypePropertyInfo = "RecentChooser::sort-type" attrGet _ = getRecentChooserSortType attrSet _ = setRecentChooserSortType attrConstruct _ = constructRecentChooserSortType type instance AttributeList RecentChooser = '[ '("filter", RecentChooserFilterPropertyInfo), '("limit", RecentChooserLimitPropertyInfo), '("local-only", RecentChooserLocalOnlyPropertyInfo), '("recent-manager", RecentChooserRecentManagerPropertyInfo), '("select-multiple", RecentChooserSelectMultiplePropertyInfo), '("show-icons", RecentChooserShowIconsPropertyInfo), '("show-not-found", RecentChooserShowNotFoundPropertyInfo), '("show-private", RecentChooserShowPrivatePropertyInfo), '("show-tips", RecentChooserShowTipsPropertyInfo), '("sort-type", RecentChooserSortTypePropertyInfo)] type instance AttributeList RecentChooserDialog = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("filter", RecentChooserFilterPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("limit", RecentChooserLimitPropertyInfo), '("local-only", RecentChooserLocalOnlyPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("recent-manager", RecentChooserRecentManagerPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("select-multiple", RecentChooserSelectMultiplePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-icons", RecentChooserShowIconsPropertyInfo), '("show-not-found", RecentChooserShowNotFoundPropertyInfo), '("show-private", RecentChooserShowPrivatePropertyInfo), '("show-tips", RecentChooserShowTipsPropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("sort-type", RecentChooserSortTypePropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("use-header-bar", DialogUseHeaderBarPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] -- VVV Prop "show-numbers" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getRecentChooserMenuShowNumbers :: (MonadIO m, RecentChooserMenuK o) => o -> m Bool getRecentChooserMenuShowNumbers obj = liftIO $ getObjectPropertyBool obj "show-numbers" setRecentChooserMenuShowNumbers :: (MonadIO m, RecentChooserMenuK o) => o -> Bool -> m () setRecentChooserMenuShowNumbers obj val = liftIO $ setObjectPropertyBool obj "show-numbers" val constructRecentChooserMenuShowNumbers :: Bool -> IO ([Char], GValue) constructRecentChooserMenuShowNumbers val = constructObjectPropertyBool "show-numbers" val data RecentChooserMenuShowNumbersPropertyInfo instance AttrInfo RecentChooserMenuShowNumbersPropertyInfo where type AttrAllowedOps RecentChooserMenuShowNumbersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentChooserMenuShowNumbersPropertyInfo = (~) Bool type AttrBaseTypeConstraint RecentChooserMenuShowNumbersPropertyInfo = RecentChooserMenuK type AttrGetType RecentChooserMenuShowNumbersPropertyInfo = Bool type AttrLabel RecentChooserMenuShowNumbersPropertyInfo = "RecentChooserMenu::show-numbers" attrGet _ = getRecentChooserMenuShowNumbers attrSet _ = setRecentChooserMenuShowNumbers attrConstruct _ = constructRecentChooserMenuShowNumbers type instance AttributeList RecentChooserMenu = '[ '("accel-group", MenuAccelGroupPropertyInfo), '("accel-path", MenuAccelPathPropertyInfo), '("active", MenuActivePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("attach-widget", MenuAttachWidgetPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("filter", RecentChooserFilterPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("limit", RecentChooserLimitPropertyInfo), '("local-only", RecentChooserLocalOnlyPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("monitor", MenuMonitorPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("recent-manager", RecentChooserRecentManagerPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("reserve-toggle-size", MenuReserveToggleSizePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("select-multiple", RecentChooserSelectMultiplePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-icons", RecentChooserShowIconsPropertyInfo), '("show-not-found", RecentChooserShowNotFoundPropertyInfo), '("show-numbers", RecentChooserMenuShowNumbersPropertyInfo), '("show-private", RecentChooserShowPrivatePropertyInfo), '("show-tips", RecentChooserShowTipsPropertyInfo), '("sort-type", RecentChooserSortTypePropertyInfo), '("style", WidgetStylePropertyInfo), '("take-focus", MenuShellTakeFocusPropertyInfo), '("tearoff-state", MenuTearoffStatePropertyInfo), '("tearoff-title", MenuTearoffTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList RecentChooserWidget = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("filter", RecentChooserFilterPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("limit", RecentChooserLimitPropertyInfo), '("local-only", RecentChooserLocalOnlyPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("recent-manager", RecentChooserRecentManagerPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("select-multiple", RecentChooserSelectMultiplePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-icons", RecentChooserShowIconsPropertyInfo), '("show-not-found", RecentChooserShowNotFoundPropertyInfo), '("show-private", RecentChooserShowPrivatePropertyInfo), '("show-tips", RecentChooserShowTipsPropertyInfo), '("sort-type", RecentChooserSortTypePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList RecentFilter = '[ ] -- VVV Prop "filename" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getRecentManagerFilename :: (MonadIO m, RecentManagerK o) => o -> m T.Text getRecentManagerFilename obj = liftIO $ getObjectPropertyString obj "filename" constructRecentManagerFilename :: T.Text -> IO ([Char], GValue) constructRecentManagerFilename val = constructObjectPropertyString "filename" val data RecentManagerFilenamePropertyInfo instance AttrInfo RecentManagerFilenamePropertyInfo where type AttrAllowedOps RecentManagerFilenamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RecentManagerFilenamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint RecentManagerFilenamePropertyInfo = RecentManagerK type AttrGetType RecentManagerFilenamePropertyInfo = T.Text type AttrLabel RecentManagerFilenamePropertyInfo = "RecentManager::filename" attrGet _ = getRecentManagerFilename attrSet _ = undefined attrConstruct _ = constructRecentManagerFilename -- VVV Prop "size" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getRecentManagerSize :: (MonadIO m, RecentManagerK o) => o -> m Int32 getRecentManagerSize obj = liftIO $ getObjectPropertyCInt obj "size" data RecentManagerSizePropertyInfo instance AttrInfo RecentManagerSizePropertyInfo where type AttrAllowedOps RecentManagerSizePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint RecentManagerSizePropertyInfo = (~) () type AttrBaseTypeConstraint RecentManagerSizePropertyInfo = RecentManagerK type AttrGetType RecentManagerSizePropertyInfo = Int32 type AttrLabel RecentManagerSizePropertyInfo = "RecentManager::size" attrGet _ = getRecentManagerSize attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList RecentManager = '[ '("filename", RecentManagerFilenamePropertyInfo), '("size", RecentManagerSizePropertyInfo)] -- VVV Prop "renderer" -- Type: TInterface "Gtk" "CellRenderer" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getRendererCellAccessibleRenderer :: (MonadIO m, RendererCellAccessibleK o) => o -> m CellRenderer getRendererCellAccessibleRenderer obj = liftIO $ getObjectPropertyObject obj "renderer" CellRenderer constructRendererCellAccessibleRenderer :: (CellRendererK a) => a -> IO ([Char], GValue) constructRendererCellAccessibleRenderer val = constructObjectPropertyObject "renderer" val data RendererCellAccessibleRendererPropertyInfo instance AttrInfo RendererCellAccessibleRendererPropertyInfo where type AttrAllowedOps RendererCellAccessibleRendererPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RendererCellAccessibleRendererPropertyInfo = CellRendererK type AttrBaseTypeConstraint RendererCellAccessibleRendererPropertyInfo = RendererCellAccessibleK type AttrGetType RendererCellAccessibleRendererPropertyInfo = CellRenderer type AttrLabel RendererCellAccessibleRendererPropertyInfo = "RendererCellAccessible::renderer" attrGet _ = getRendererCellAccessibleRenderer attrSet _ = undefined attrConstruct _ = constructRendererCellAccessibleRenderer type instance AttributeList RendererCellAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("renderer", RendererCellAccessibleRendererPropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "child-revealed" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getRevealerChildRevealed :: (MonadIO m, RevealerK o) => o -> m Bool getRevealerChildRevealed obj = liftIO $ getObjectPropertyBool obj "child-revealed" data RevealerChildRevealedPropertyInfo instance AttrInfo RevealerChildRevealedPropertyInfo where type AttrAllowedOps RevealerChildRevealedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint RevealerChildRevealedPropertyInfo = (~) () type AttrBaseTypeConstraint RevealerChildRevealedPropertyInfo = RevealerK type AttrGetType RevealerChildRevealedPropertyInfo = Bool type AttrLabel RevealerChildRevealedPropertyInfo = "Revealer::child-revealed" attrGet _ = getRevealerChildRevealed attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "reveal-child" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getRevealerRevealChild :: (MonadIO m, RevealerK o) => o -> m Bool getRevealerRevealChild obj = liftIO $ getObjectPropertyBool obj "reveal-child" setRevealerRevealChild :: (MonadIO m, RevealerK o) => o -> Bool -> m () setRevealerRevealChild obj val = liftIO $ setObjectPropertyBool obj "reveal-child" val constructRevealerRevealChild :: Bool -> IO ([Char], GValue) constructRevealerRevealChild val = constructObjectPropertyBool "reveal-child" val data RevealerRevealChildPropertyInfo instance AttrInfo RevealerRevealChildPropertyInfo where type AttrAllowedOps RevealerRevealChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RevealerRevealChildPropertyInfo = (~) Bool type AttrBaseTypeConstraint RevealerRevealChildPropertyInfo = RevealerK type AttrGetType RevealerRevealChildPropertyInfo = Bool type AttrLabel RevealerRevealChildPropertyInfo = "Revealer::reveal-child" attrGet _ = getRevealerRevealChild attrSet _ = setRevealerRevealChild attrConstruct _ = constructRevealerRevealChild -- VVV Prop "transition-duration" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getRevealerTransitionDuration :: (MonadIO m, RevealerK o) => o -> m Word32 getRevealerTransitionDuration obj = liftIO $ getObjectPropertyCUInt obj "transition-duration" setRevealerTransitionDuration :: (MonadIO m, RevealerK o) => o -> Word32 -> m () setRevealerTransitionDuration obj val = liftIO $ setObjectPropertyCUInt obj "transition-duration" val constructRevealerTransitionDuration :: Word32 -> IO ([Char], GValue) constructRevealerTransitionDuration val = constructObjectPropertyCUInt "transition-duration" val data RevealerTransitionDurationPropertyInfo instance AttrInfo RevealerTransitionDurationPropertyInfo where type AttrAllowedOps RevealerTransitionDurationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RevealerTransitionDurationPropertyInfo = (~) Word32 type AttrBaseTypeConstraint RevealerTransitionDurationPropertyInfo = RevealerK type AttrGetType RevealerTransitionDurationPropertyInfo = Word32 type AttrLabel RevealerTransitionDurationPropertyInfo = "Revealer::transition-duration" attrGet _ = getRevealerTransitionDuration attrSet _ = setRevealerTransitionDuration attrConstruct _ = constructRevealerTransitionDuration -- VVV Prop "transition-type" -- Type: TInterface "Gtk" "RevealerTransitionType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getRevealerTransitionType :: (MonadIO m, RevealerK o) => o -> m RevealerTransitionType getRevealerTransitionType obj = liftIO $ getObjectPropertyEnum obj "transition-type" setRevealerTransitionType :: (MonadIO m, RevealerK o) => o -> RevealerTransitionType -> m () setRevealerTransitionType obj val = liftIO $ setObjectPropertyEnum obj "transition-type" val constructRevealerTransitionType :: RevealerTransitionType -> IO ([Char], GValue) constructRevealerTransitionType val = constructObjectPropertyEnum "transition-type" val data RevealerTransitionTypePropertyInfo instance AttrInfo RevealerTransitionTypePropertyInfo where type AttrAllowedOps RevealerTransitionTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RevealerTransitionTypePropertyInfo = (~) RevealerTransitionType type AttrBaseTypeConstraint RevealerTransitionTypePropertyInfo = RevealerK type AttrGetType RevealerTransitionTypePropertyInfo = RevealerTransitionType type AttrLabel RevealerTransitionTypePropertyInfo = "Revealer::transition-type" attrGet _ = getRevealerTransitionType attrSet _ = setRevealerTransitionType attrConstruct _ = constructRevealerTransitionType type instance AttributeList Revealer = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("child-revealed", RevealerChildRevealedPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("reveal-child", RevealerRevealChildPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transition-duration", RevealerTransitionDurationPropertyInfo), '("transition-type", RevealerTransitionTypePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "digits" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getScaleDigits :: (MonadIO m, ScaleK o) => o -> m Int32 getScaleDigits obj = liftIO $ getObjectPropertyCInt obj "digits" setScaleDigits :: (MonadIO m, ScaleK o) => o -> Int32 -> m () setScaleDigits obj val = liftIO $ setObjectPropertyCInt obj "digits" val constructScaleDigits :: Int32 -> IO ([Char], GValue) constructScaleDigits val = constructObjectPropertyCInt "digits" val data ScaleDigitsPropertyInfo instance AttrInfo ScaleDigitsPropertyInfo where type AttrAllowedOps ScaleDigitsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScaleDigitsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ScaleDigitsPropertyInfo = ScaleK type AttrGetType ScaleDigitsPropertyInfo = Int32 type AttrLabel ScaleDigitsPropertyInfo = "Scale::digits" attrGet _ = getScaleDigits attrSet _ = setScaleDigits attrConstruct _ = constructScaleDigits -- VVV Prop "draw-value" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getScaleDrawValue :: (MonadIO m, ScaleK o) => o -> m Bool getScaleDrawValue obj = liftIO $ getObjectPropertyBool obj "draw-value" setScaleDrawValue :: (MonadIO m, ScaleK o) => o -> Bool -> m () setScaleDrawValue obj val = liftIO $ setObjectPropertyBool obj "draw-value" val constructScaleDrawValue :: Bool -> IO ([Char], GValue) constructScaleDrawValue val = constructObjectPropertyBool "draw-value" val data ScaleDrawValuePropertyInfo instance AttrInfo ScaleDrawValuePropertyInfo where type AttrAllowedOps ScaleDrawValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScaleDrawValuePropertyInfo = (~) Bool type AttrBaseTypeConstraint ScaleDrawValuePropertyInfo = ScaleK type AttrGetType ScaleDrawValuePropertyInfo = Bool type AttrLabel ScaleDrawValuePropertyInfo = "Scale::draw-value" attrGet _ = getScaleDrawValue attrSet _ = setScaleDrawValue attrConstruct _ = constructScaleDrawValue -- VVV Prop "has-origin" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getScaleHasOrigin :: (MonadIO m, ScaleK o) => o -> m Bool getScaleHasOrigin obj = liftIO $ getObjectPropertyBool obj "has-origin" setScaleHasOrigin :: (MonadIO m, ScaleK o) => o -> Bool -> m () setScaleHasOrigin obj val = liftIO $ setObjectPropertyBool obj "has-origin" val constructScaleHasOrigin :: Bool -> IO ([Char], GValue) constructScaleHasOrigin val = constructObjectPropertyBool "has-origin" val data ScaleHasOriginPropertyInfo instance AttrInfo ScaleHasOriginPropertyInfo where type AttrAllowedOps ScaleHasOriginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScaleHasOriginPropertyInfo = (~) Bool type AttrBaseTypeConstraint ScaleHasOriginPropertyInfo = ScaleK type AttrGetType ScaleHasOriginPropertyInfo = Bool type AttrLabel ScaleHasOriginPropertyInfo = "Scale::has-origin" attrGet _ = getScaleHasOrigin attrSet _ = setScaleHasOrigin attrConstruct _ = constructScaleHasOrigin -- VVV Prop "value-pos" -- Type: TInterface "Gtk" "PositionType" -- Flags: [PropertyReadable,PropertyWritable] getScaleValuePos :: (MonadIO m, ScaleK o) => o -> m PositionType getScaleValuePos obj = liftIO $ getObjectPropertyEnum obj "value-pos" setScaleValuePos :: (MonadIO m, ScaleK o) => o -> PositionType -> m () setScaleValuePos obj val = liftIO $ setObjectPropertyEnum obj "value-pos" val constructScaleValuePos :: PositionType -> IO ([Char], GValue) constructScaleValuePos val = constructObjectPropertyEnum "value-pos" val data ScaleValuePosPropertyInfo instance AttrInfo ScaleValuePosPropertyInfo where type AttrAllowedOps ScaleValuePosPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScaleValuePosPropertyInfo = (~) PositionType type AttrBaseTypeConstraint ScaleValuePosPropertyInfo = ScaleK type AttrGetType ScaleValuePosPropertyInfo = PositionType type AttrLabel ScaleValuePosPropertyInfo = "Scale::value-pos" attrGet _ = getScaleValuePos attrSet _ = setScaleValuePos attrConstruct _ = constructScaleValuePos type instance AttributeList Scale = '[ '("adjustment", RangeAdjustmentPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("digits", ScaleDigitsPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-value", ScaleDrawValuePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("fill-level", RangeFillLevelPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-origin", ScaleHasOriginPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inverted", RangeInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("lower-stepper-sensitivity", RangeLowerStepperSensitivityPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("restrict-to-fill-level", RangeRestrictToFillLevelPropertyInfo), '("round-digits", RangeRoundDigitsPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-fill-level", RangeShowFillLevelPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("upper-stepper-sensitivity", RangeUpperStepperSensitivityPropertyInfo), '("valign", WidgetValignPropertyInfo), '("value-pos", ScaleValuePosPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList ScaleAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "adjustment" -- Type: TInterface "Gtk" "Adjustment" -- Flags: [PropertyReadable,PropertyWritable] getScaleButtonAdjustment :: (MonadIO m, ScaleButtonK o) => o -> m Adjustment getScaleButtonAdjustment obj = liftIO $ getObjectPropertyObject obj "adjustment" Adjustment setScaleButtonAdjustment :: (MonadIO m, ScaleButtonK o, AdjustmentK a) => o -> a -> m () setScaleButtonAdjustment obj val = liftIO $ setObjectPropertyObject obj "adjustment" val constructScaleButtonAdjustment :: (AdjustmentK a) => a -> IO ([Char], GValue) constructScaleButtonAdjustment val = constructObjectPropertyObject "adjustment" val data ScaleButtonAdjustmentPropertyInfo instance AttrInfo ScaleButtonAdjustmentPropertyInfo where type AttrAllowedOps ScaleButtonAdjustmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScaleButtonAdjustmentPropertyInfo = AdjustmentK type AttrBaseTypeConstraint ScaleButtonAdjustmentPropertyInfo = ScaleButtonK type AttrGetType ScaleButtonAdjustmentPropertyInfo = Adjustment type AttrLabel ScaleButtonAdjustmentPropertyInfo = "ScaleButton::adjustment" attrGet _ = getScaleButtonAdjustment attrSet _ = setScaleButtonAdjustment attrConstruct _ = constructScaleButtonAdjustment -- VVV Prop "icons" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyReadable,PropertyWritable] getScaleButtonIcons :: (MonadIO m, ScaleButtonK o) => o -> m [T.Text] getScaleButtonIcons obj = liftIO $ getObjectPropertyStringArray obj "icons" setScaleButtonIcons :: (MonadIO m, ScaleButtonK o) => o -> [T.Text] -> m () setScaleButtonIcons obj val = liftIO $ setObjectPropertyStringArray obj "icons" val constructScaleButtonIcons :: [T.Text] -> IO ([Char], GValue) constructScaleButtonIcons val = constructObjectPropertyStringArray "icons" val data ScaleButtonIconsPropertyInfo instance AttrInfo ScaleButtonIconsPropertyInfo where type AttrAllowedOps ScaleButtonIconsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScaleButtonIconsPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint ScaleButtonIconsPropertyInfo = ScaleButtonK type AttrGetType ScaleButtonIconsPropertyInfo = [T.Text] type AttrLabel ScaleButtonIconsPropertyInfo = "ScaleButton::icons" attrGet _ = getScaleButtonIcons attrSet _ = setScaleButtonIcons attrConstruct _ = constructScaleButtonIcons -- VVV Prop "size" -- Type: TInterface "Gtk" "IconSize" -- Flags: [PropertyReadable,PropertyWritable] getScaleButtonSize :: (MonadIO m, ScaleButtonK o) => o -> m IconSize getScaleButtonSize obj = liftIO $ getObjectPropertyEnum obj "size" setScaleButtonSize :: (MonadIO m, ScaleButtonK o) => o -> IconSize -> m () setScaleButtonSize obj val = liftIO $ setObjectPropertyEnum obj "size" val constructScaleButtonSize :: IconSize -> IO ([Char], GValue) constructScaleButtonSize val = constructObjectPropertyEnum "size" val data ScaleButtonSizePropertyInfo instance AttrInfo ScaleButtonSizePropertyInfo where type AttrAllowedOps ScaleButtonSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScaleButtonSizePropertyInfo = (~) IconSize type AttrBaseTypeConstraint ScaleButtonSizePropertyInfo = ScaleButtonK type AttrGetType ScaleButtonSizePropertyInfo = IconSize type AttrLabel ScaleButtonSizePropertyInfo = "ScaleButton::size" attrGet _ = getScaleButtonSize attrSet _ = setScaleButtonSize attrConstruct _ = constructScaleButtonSize -- VVV Prop "value" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getScaleButtonValue :: (MonadIO m, ScaleButtonK o) => o -> m Double getScaleButtonValue obj = liftIO $ getObjectPropertyDouble obj "value" setScaleButtonValue :: (MonadIO m, ScaleButtonK o) => o -> Double -> m () setScaleButtonValue obj val = liftIO $ setObjectPropertyDouble obj "value" val constructScaleButtonValue :: Double -> IO ([Char], GValue) constructScaleButtonValue val = constructObjectPropertyDouble "value" val data ScaleButtonValuePropertyInfo instance AttrInfo ScaleButtonValuePropertyInfo where type AttrAllowedOps ScaleButtonValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScaleButtonValuePropertyInfo = (~) Double type AttrBaseTypeConstraint ScaleButtonValuePropertyInfo = ScaleButtonK type AttrGetType ScaleButtonValuePropertyInfo = Double type AttrLabel ScaleButtonValuePropertyInfo = "ScaleButton::value" attrGet _ = getScaleButtonValue attrSet _ = setScaleButtonValue attrConstruct _ = constructScaleButtonValue type instance AttributeList ScaleButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("adjustment", ScaleButtonAdjustmentPropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("icons", ScaleButtonIconsPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("size", ScaleButtonSizePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("value", ScaleButtonValuePropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] type instance AttributeList ScaleButtonAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "hadjustment" -- Type: TInterface "Gtk" "Adjustment" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getScrollableHadjustment :: (MonadIO m, ScrollableK o) => o -> m Adjustment getScrollableHadjustment obj = liftIO $ getObjectPropertyObject obj "hadjustment" Adjustment setScrollableHadjustment :: (MonadIO m, ScrollableK o, AdjustmentK a) => o -> a -> m () setScrollableHadjustment obj val = liftIO $ setObjectPropertyObject obj "hadjustment" val constructScrollableHadjustment :: (AdjustmentK a) => a -> IO ([Char], GValue) constructScrollableHadjustment val = constructObjectPropertyObject "hadjustment" val data ScrollableHadjustmentPropertyInfo instance AttrInfo ScrollableHadjustmentPropertyInfo where type AttrAllowedOps ScrollableHadjustmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrollableHadjustmentPropertyInfo = AdjustmentK type AttrBaseTypeConstraint ScrollableHadjustmentPropertyInfo = ScrollableK type AttrGetType ScrollableHadjustmentPropertyInfo = Adjustment type AttrLabel ScrollableHadjustmentPropertyInfo = "Scrollable::hadjustment" attrGet _ = getScrollableHadjustment attrSet _ = setScrollableHadjustment attrConstruct _ = constructScrollableHadjustment -- VVV Prop "hscroll-policy" -- Type: TInterface "Gtk" "ScrollablePolicy" -- Flags: [PropertyReadable,PropertyWritable] getScrollableHscrollPolicy :: (MonadIO m, ScrollableK o) => o -> m ScrollablePolicy getScrollableHscrollPolicy obj = liftIO $ getObjectPropertyEnum obj "hscroll-policy" setScrollableHscrollPolicy :: (MonadIO m, ScrollableK o) => o -> ScrollablePolicy -> m () setScrollableHscrollPolicy obj val = liftIO $ setObjectPropertyEnum obj "hscroll-policy" val constructScrollableHscrollPolicy :: ScrollablePolicy -> IO ([Char], GValue) constructScrollableHscrollPolicy val = constructObjectPropertyEnum "hscroll-policy" val data ScrollableHscrollPolicyPropertyInfo instance AttrInfo ScrollableHscrollPolicyPropertyInfo where type AttrAllowedOps ScrollableHscrollPolicyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrollableHscrollPolicyPropertyInfo = (~) ScrollablePolicy type AttrBaseTypeConstraint ScrollableHscrollPolicyPropertyInfo = ScrollableK type AttrGetType ScrollableHscrollPolicyPropertyInfo = ScrollablePolicy type AttrLabel ScrollableHscrollPolicyPropertyInfo = "Scrollable::hscroll-policy" attrGet _ = getScrollableHscrollPolicy attrSet _ = setScrollableHscrollPolicy attrConstruct _ = constructScrollableHscrollPolicy -- VVV Prop "vadjustment" -- Type: TInterface "Gtk" "Adjustment" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getScrollableVadjustment :: (MonadIO m, ScrollableK o) => o -> m Adjustment getScrollableVadjustment obj = liftIO $ getObjectPropertyObject obj "vadjustment" Adjustment setScrollableVadjustment :: (MonadIO m, ScrollableK o, AdjustmentK a) => o -> a -> m () setScrollableVadjustment obj val = liftIO $ setObjectPropertyObject obj "vadjustment" val constructScrollableVadjustment :: (AdjustmentK a) => a -> IO ([Char], GValue) constructScrollableVadjustment val = constructObjectPropertyObject "vadjustment" val data ScrollableVadjustmentPropertyInfo instance AttrInfo ScrollableVadjustmentPropertyInfo where type AttrAllowedOps ScrollableVadjustmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrollableVadjustmentPropertyInfo = AdjustmentK type AttrBaseTypeConstraint ScrollableVadjustmentPropertyInfo = ScrollableK type AttrGetType ScrollableVadjustmentPropertyInfo = Adjustment type AttrLabel ScrollableVadjustmentPropertyInfo = "Scrollable::vadjustment" attrGet _ = getScrollableVadjustment attrSet _ = setScrollableVadjustment attrConstruct _ = constructScrollableVadjustment -- VVV Prop "vscroll-policy" -- Type: TInterface "Gtk" "ScrollablePolicy" -- Flags: [PropertyReadable,PropertyWritable] getScrollableVscrollPolicy :: (MonadIO m, ScrollableK o) => o -> m ScrollablePolicy getScrollableVscrollPolicy obj = liftIO $ getObjectPropertyEnum obj "vscroll-policy" setScrollableVscrollPolicy :: (MonadIO m, ScrollableK o) => o -> ScrollablePolicy -> m () setScrollableVscrollPolicy obj val = liftIO $ setObjectPropertyEnum obj "vscroll-policy" val constructScrollableVscrollPolicy :: ScrollablePolicy -> IO ([Char], GValue) constructScrollableVscrollPolicy val = constructObjectPropertyEnum "vscroll-policy" val data ScrollableVscrollPolicyPropertyInfo instance AttrInfo ScrollableVscrollPolicyPropertyInfo where type AttrAllowedOps ScrollableVscrollPolicyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrollableVscrollPolicyPropertyInfo = (~) ScrollablePolicy type AttrBaseTypeConstraint ScrollableVscrollPolicyPropertyInfo = ScrollableK type AttrGetType ScrollableVscrollPolicyPropertyInfo = ScrollablePolicy type AttrLabel ScrollableVscrollPolicyPropertyInfo = "Scrollable::vscroll-policy" attrGet _ = getScrollableVscrollPolicy attrSet _ = setScrollableVscrollPolicy attrConstruct _ = constructScrollableVscrollPolicy type instance AttributeList Scrollable = '[ '("hadjustment", ScrollableHadjustmentPropertyInfo), '("hscroll-policy", ScrollableHscrollPolicyPropertyInfo), '("vadjustment", ScrollableVadjustmentPropertyInfo), '("vscroll-policy", ScrollableVscrollPolicyPropertyInfo)] type instance AttributeList Scrollbar = '[ '("adjustment", RangeAdjustmentPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("fill-level", RangeFillLevelPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inverted", RangeInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("lower-stepper-sensitivity", RangeLowerStepperSensitivityPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("restrict-to-fill-level", RangeRestrictToFillLevelPropertyInfo), '("round-digits", RangeRoundDigitsPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-fill-level", RangeShowFillLevelPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("upper-stepper-sensitivity", RangeUpperStepperSensitivityPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "hadjustment" -- Type: TInterface "Gtk" "Adjustment" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getScrolledWindowHadjustment :: (MonadIO m, ScrolledWindowK o) => o -> m Adjustment getScrolledWindowHadjustment obj = liftIO $ getObjectPropertyObject obj "hadjustment" Adjustment setScrolledWindowHadjustment :: (MonadIO m, ScrolledWindowK o, AdjustmentK a) => o -> a -> m () setScrolledWindowHadjustment obj val = liftIO $ setObjectPropertyObject obj "hadjustment" val constructScrolledWindowHadjustment :: (AdjustmentK a) => a -> IO ([Char], GValue) constructScrolledWindowHadjustment val = constructObjectPropertyObject "hadjustment" val data ScrolledWindowHadjustmentPropertyInfo instance AttrInfo ScrolledWindowHadjustmentPropertyInfo where type AttrAllowedOps ScrolledWindowHadjustmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowHadjustmentPropertyInfo = AdjustmentK type AttrBaseTypeConstraint ScrolledWindowHadjustmentPropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowHadjustmentPropertyInfo = Adjustment type AttrLabel ScrolledWindowHadjustmentPropertyInfo = "ScrolledWindow::hadjustment" attrGet _ = getScrolledWindowHadjustment attrSet _ = setScrolledWindowHadjustment attrConstruct _ = constructScrolledWindowHadjustment -- VVV Prop "hscrollbar-policy" -- Type: TInterface "Gtk" "PolicyType" -- Flags: [PropertyReadable,PropertyWritable] getScrolledWindowHscrollbarPolicy :: (MonadIO m, ScrolledWindowK o) => o -> m PolicyType getScrolledWindowHscrollbarPolicy obj = liftIO $ getObjectPropertyEnum obj "hscrollbar-policy" setScrolledWindowHscrollbarPolicy :: (MonadIO m, ScrolledWindowK o) => o -> PolicyType -> m () setScrolledWindowHscrollbarPolicy obj val = liftIO $ setObjectPropertyEnum obj "hscrollbar-policy" val constructScrolledWindowHscrollbarPolicy :: PolicyType -> IO ([Char], GValue) constructScrolledWindowHscrollbarPolicy val = constructObjectPropertyEnum "hscrollbar-policy" val data ScrolledWindowHscrollbarPolicyPropertyInfo instance AttrInfo ScrolledWindowHscrollbarPolicyPropertyInfo where type AttrAllowedOps ScrolledWindowHscrollbarPolicyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowHscrollbarPolicyPropertyInfo = (~) PolicyType type AttrBaseTypeConstraint ScrolledWindowHscrollbarPolicyPropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowHscrollbarPolicyPropertyInfo = PolicyType type AttrLabel ScrolledWindowHscrollbarPolicyPropertyInfo = "ScrolledWindow::hscrollbar-policy" attrGet _ = getScrolledWindowHscrollbarPolicy attrSet _ = setScrolledWindowHscrollbarPolicy attrConstruct _ = constructScrolledWindowHscrollbarPolicy -- VVV Prop "kinetic-scrolling" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getScrolledWindowKineticScrolling :: (MonadIO m, ScrolledWindowK o) => o -> m Bool getScrolledWindowKineticScrolling obj = liftIO $ getObjectPropertyBool obj "kinetic-scrolling" setScrolledWindowKineticScrolling :: (MonadIO m, ScrolledWindowK o) => o -> Bool -> m () setScrolledWindowKineticScrolling obj val = liftIO $ setObjectPropertyBool obj "kinetic-scrolling" val constructScrolledWindowKineticScrolling :: Bool -> IO ([Char], GValue) constructScrolledWindowKineticScrolling val = constructObjectPropertyBool "kinetic-scrolling" val data ScrolledWindowKineticScrollingPropertyInfo instance AttrInfo ScrolledWindowKineticScrollingPropertyInfo where type AttrAllowedOps ScrolledWindowKineticScrollingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowKineticScrollingPropertyInfo = (~) Bool type AttrBaseTypeConstraint ScrolledWindowKineticScrollingPropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowKineticScrollingPropertyInfo = Bool type AttrLabel ScrolledWindowKineticScrollingPropertyInfo = "ScrolledWindow::kinetic-scrolling" attrGet _ = getScrolledWindowKineticScrolling attrSet _ = setScrolledWindowKineticScrolling attrConstruct _ = constructScrolledWindowKineticScrolling -- VVV Prop "min-content-height" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getScrolledWindowMinContentHeight :: (MonadIO m, ScrolledWindowK o) => o -> m Int32 getScrolledWindowMinContentHeight obj = liftIO $ getObjectPropertyCInt obj "min-content-height" setScrolledWindowMinContentHeight :: (MonadIO m, ScrolledWindowK o) => o -> Int32 -> m () setScrolledWindowMinContentHeight obj val = liftIO $ setObjectPropertyCInt obj "min-content-height" val constructScrolledWindowMinContentHeight :: Int32 -> IO ([Char], GValue) constructScrolledWindowMinContentHeight val = constructObjectPropertyCInt "min-content-height" val data ScrolledWindowMinContentHeightPropertyInfo instance AttrInfo ScrolledWindowMinContentHeightPropertyInfo where type AttrAllowedOps ScrolledWindowMinContentHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowMinContentHeightPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ScrolledWindowMinContentHeightPropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowMinContentHeightPropertyInfo = Int32 type AttrLabel ScrolledWindowMinContentHeightPropertyInfo = "ScrolledWindow::min-content-height" attrGet _ = getScrolledWindowMinContentHeight attrSet _ = setScrolledWindowMinContentHeight attrConstruct _ = constructScrolledWindowMinContentHeight -- VVV Prop "min-content-width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getScrolledWindowMinContentWidth :: (MonadIO m, ScrolledWindowK o) => o -> m Int32 getScrolledWindowMinContentWidth obj = liftIO $ getObjectPropertyCInt obj "min-content-width" setScrolledWindowMinContentWidth :: (MonadIO m, ScrolledWindowK o) => o -> Int32 -> m () setScrolledWindowMinContentWidth obj val = liftIO $ setObjectPropertyCInt obj "min-content-width" val constructScrolledWindowMinContentWidth :: Int32 -> IO ([Char], GValue) constructScrolledWindowMinContentWidth val = constructObjectPropertyCInt "min-content-width" val data ScrolledWindowMinContentWidthPropertyInfo instance AttrInfo ScrolledWindowMinContentWidthPropertyInfo where type AttrAllowedOps ScrolledWindowMinContentWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowMinContentWidthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ScrolledWindowMinContentWidthPropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowMinContentWidthPropertyInfo = Int32 type AttrLabel ScrolledWindowMinContentWidthPropertyInfo = "ScrolledWindow::min-content-width" attrGet _ = getScrolledWindowMinContentWidth attrSet _ = setScrolledWindowMinContentWidth attrConstruct _ = constructScrolledWindowMinContentWidth -- VVV Prop "overlay-scrolling" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getScrolledWindowOverlayScrolling :: (MonadIO m, ScrolledWindowK o) => o -> m Bool getScrolledWindowOverlayScrolling obj = liftIO $ getObjectPropertyBool obj "overlay-scrolling" setScrolledWindowOverlayScrolling :: (MonadIO m, ScrolledWindowK o) => o -> Bool -> m () setScrolledWindowOverlayScrolling obj val = liftIO $ setObjectPropertyBool obj "overlay-scrolling" val constructScrolledWindowOverlayScrolling :: Bool -> IO ([Char], GValue) constructScrolledWindowOverlayScrolling val = constructObjectPropertyBool "overlay-scrolling" val data ScrolledWindowOverlayScrollingPropertyInfo instance AttrInfo ScrolledWindowOverlayScrollingPropertyInfo where type AttrAllowedOps ScrolledWindowOverlayScrollingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowOverlayScrollingPropertyInfo = (~) Bool type AttrBaseTypeConstraint ScrolledWindowOverlayScrollingPropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowOverlayScrollingPropertyInfo = Bool type AttrLabel ScrolledWindowOverlayScrollingPropertyInfo = "ScrolledWindow::overlay-scrolling" attrGet _ = getScrolledWindowOverlayScrolling attrSet _ = setScrolledWindowOverlayScrolling attrConstruct _ = constructScrolledWindowOverlayScrolling -- VVV Prop "shadow-type" -- Type: TInterface "Gtk" "ShadowType" -- Flags: [PropertyReadable,PropertyWritable] getScrolledWindowShadowType :: (MonadIO m, ScrolledWindowK o) => o -> m ShadowType getScrolledWindowShadowType obj = liftIO $ getObjectPropertyEnum obj "shadow-type" setScrolledWindowShadowType :: (MonadIO m, ScrolledWindowK o) => o -> ShadowType -> m () setScrolledWindowShadowType obj val = liftIO $ setObjectPropertyEnum obj "shadow-type" val constructScrolledWindowShadowType :: ShadowType -> IO ([Char], GValue) constructScrolledWindowShadowType val = constructObjectPropertyEnum "shadow-type" val data ScrolledWindowShadowTypePropertyInfo instance AttrInfo ScrolledWindowShadowTypePropertyInfo where type AttrAllowedOps ScrolledWindowShadowTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowShadowTypePropertyInfo = (~) ShadowType type AttrBaseTypeConstraint ScrolledWindowShadowTypePropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowShadowTypePropertyInfo = ShadowType type AttrLabel ScrolledWindowShadowTypePropertyInfo = "ScrolledWindow::shadow-type" attrGet _ = getScrolledWindowShadowType attrSet _ = setScrolledWindowShadowType attrConstruct _ = constructScrolledWindowShadowType -- VVV Prop "vadjustment" -- Type: TInterface "Gtk" "Adjustment" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getScrolledWindowVadjustment :: (MonadIO m, ScrolledWindowK o) => o -> m Adjustment getScrolledWindowVadjustment obj = liftIO $ getObjectPropertyObject obj "vadjustment" Adjustment setScrolledWindowVadjustment :: (MonadIO m, ScrolledWindowK o, AdjustmentK a) => o -> a -> m () setScrolledWindowVadjustment obj val = liftIO $ setObjectPropertyObject obj "vadjustment" val constructScrolledWindowVadjustment :: (AdjustmentK a) => a -> IO ([Char], GValue) constructScrolledWindowVadjustment val = constructObjectPropertyObject "vadjustment" val data ScrolledWindowVadjustmentPropertyInfo instance AttrInfo ScrolledWindowVadjustmentPropertyInfo where type AttrAllowedOps ScrolledWindowVadjustmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowVadjustmentPropertyInfo = AdjustmentK type AttrBaseTypeConstraint ScrolledWindowVadjustmentPropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowVadjustmentPropertyInfo = Adjustment type AttrLabel ScrolledWindowVadjustmentPropertyInfo = "ScrolledWindow::vadjustment" attrGet _ = getScrolledWindowVadjustment attrSet _ = setScrolledWindowVadjustment attrConstruct _ = constructScrolledWindowVadjustment -- VVV Prop "vscrollbar-policy" -- Type: TInterface "Gtk" "PolicyType" -- Flags: [PropertyReadable,PropertyWritable] getScrolledWindowVscrollbarPolicy :: (MonadIO m, ScrolledWindowK o) => o -> m PolicyType getScrolledWindowVscrollbarPolicy obj = liftIO $ getObjectPropertyEnum obj "vscrollbar-policy" setScrolledWindowVscrollbarPolicy :: (MonadIO m, ScrolledWindowK o) => o -> PolicyType -> m () setScrolledWindowVscrollbarPolicy obj val = liftIO $ setObjectPropertyEnum obj "vscrollbar-policy" val constructScrolledWindowVscrollbarPolicy :: PolicyType -> IO ([Char], GValue) constructScrolledWindowVscrollbarPolicy val = constructObjectPropertyEnum "vscrollbar-policy" val data ScrolledWindowVscrollbarPolicyPropertyInfo instance AttrInfo ScrolledWindowVscrollbarPolicyPropertyInfo where type AttrAllowedOps ScrolledWindowVscrollbarPolicyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowVscrollbarPolicyPropertyInfo = (~) PolicyType type AttrBaseTypeConstraint ScrolledWindowVscrollbarPolicyPropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowVscrollbarPolicyPropertyInfo = PolicyType type AttrLabel ScrolledWindowVscrollbarPolicyPropertyInfo = "ScrolledWindow::vscrollbar-policy" attrGet _ = getScrolledWindowVscrollbarPolicy attrSet _ = setScrolledWindowVscrollbarPolicy attrConstruct _ = constructScrolledWindowVscrollbarPolicy -- VVV Prop "window-placement" -- Type: TInterface "Gtk" "CornerType" -- Flags: [PropertyReadable,PropertyWritable] getScrolledWindowWindowPlacement :: (MonadIO m, ScrolledWindowK o) => o -> m CornerType getScrolledWindowWindowPlacement obj = liftIO $ getObjectPropertyEnum obj "window-placement" setScrolledWindowWindowPlacement :: (MonadIO m, ScrolledWindowK o) => o -> CornerType -> m () setScrolledWindowWindowPlacement obj val = liftIO $ setObjectPropertyEnum obj "window-placement" val constructScrolledWindowWindowPlacement :: CornerType -> IO ([Char], GValue) constructScrolledWindowWindowPlacement val = constructObjectPropertyEnum "window-placement" val data ScrolledWindowWindowPlacementPropertyInfo instance AttrInfo ScrolledWindowWindowPlacementPropertyInfo where type AttrAllowedOps ScrolledWindowWindowPlacementPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowWindowPlacementPropertyInfo = (~) CornerType type AttrBaseTypeConstraint ScrolledWindowWindowPlacementPropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowWindowPlacementPropertyInfo = CornerType type AttrLabel ScrolledWindowWindowPlacementPropertyInfo = "ScrolledWindow::window-placement" attrGet _ = getScrolledWindowWindowPlacement attrSet _ = setScrolledWindowWindowPlacement attrConstruct _ = constructScrolledWindowWindowPlacement -- VVV Prop "window-placement-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getScrolledWindowWindowPlacementSet :: (MonadIO m, ScrolledWindowK o) => o -> m Bool getScrolledWindowWindowPlacementSet obj = liftIO $ getObjectPropertyBool obj "window-placement-set" setScrolledWindowWindowPlacementSet :: (MonadIO m, ScrolledWindowK o) => o -> Bool -> m () setScrolledWindowWindowPlacementSet obj val = liftIO $ setObjectPropertyBool obj "window-placement-set" val constructScrolledWindowWindowPlacementSet :: Bool -> IO ([Char], GValue) constructScrolledWindowWindowPlacementSet val = constructObjectPropertyBool "window-placement-set" val data ScrolledWindowWindowPlacementSetPropertyInfo instance AttrInfo ScrolledWindowWindowPlacementSetPropertyInfo where type AttrAllowedOps ScrolledWindowWindowPlacementSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ScrolledWindowWindowPlacementSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint ScrolledWindowWindowPlacementSetPropertyInfo = ScrolledWindowK type AttrGetType ScrolledWindowWindowPlacementSetPropertyInfo = Bool type AttrLabel ScrolledWindowWindowPlacementSetPropertyInfo = "ScrolledWindow::window-placement-set" attrGet _ = getScrolledWindowWindowPlacementSet attrSet _ = setScrolledWindowWindowPlacementSet attrConstruct _ = constructScrolledWindowWindowPlacementSet type instance AttributeList ScrolledWindow = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("hadjustment", ScrolledWindowHadjustmentPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hscrollbar-policy", ScrolledWindowHscrollbarPolicyPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("kinetic-scrolling", ScrolledWindowKineticScrollingPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("min-content-height", ScrolledWindowMinContentHeightPropertyInfo), '("min-content-width", ScrolledWindowMinContentWidthPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("overlay-scrolling", ScrolledWindowOverlayScrollingPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", ScrolledWindowShadowTypePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("vadjustment", ScrolledWindowVadjustmentPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("vscrollbar-policy", ScrolledWindowVscrollbarPolicyPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-placement", ScrolledWindowWindowPlacementPropertyInfo), '("window-placement-set", ScrolledWindowWindowPlacementSetPropertyInfo)] type instance AttributeList ScrolledWindowAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "search-mode-enabled" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSearchBarSearchModeEnabled :: (MonadIO m, SearchBarK o) => o -> m Bool getSearchBarSearchModeEnabled obj = liftIO $ getObjectPropertyBool obj "search-mode-enabled" setSearchBarSearchModeEnabled :: (MonadIO m, SearchBarK o) => o -> Bool -> m () setSearchBarSearchModeEnabled obj val = liftIO $ setObjectPropertyBool obj "search-mode-enabled" val constructSearchBarSearchModeEnabled :: Bool -> IO ([Char], GValue) constructSearchBarSearchModeEnabled val = constructObjectPropertyBool "search-mode-enabled" val data SearchBarSearchModeEnabledPropertyInfo instance AttrInfo SearchBarSearchModeEnabledPropertyInfo where type AttrAllowedOps SearchBarSearchModeEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SearchBarSearchModeEnabledPropertyInfo = (~) Bool type AttrBaseTypeConstraint SearchBarSearchModeEnabledPropertyInfo = SearchBarK type AttrGetType SearchBarSearchModeEnabledPropertyInfo = Bool type AttrLabel SearchBarSearchModeEnabledPropertyInfo = "SearchBar::search-mode-enabled" attrGet _ = getSearchBarSearchModeEnabled attrSet _ = setSearchBarSearchModeEnabled attrConstruct _ = constructSearchBarSearchModeEnabled -- VVV Prop "show-close-button" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSearchBarShowCloseButton :: (MonadIO m, SearchBarK o) => o -> m Bool getSearchBarShowCloseButton obj = liftIO $ getObjectPropertyBool obj "show-close-button" setSearchBarShowCloseButton :: (MonadIO m, SearchBarK o) => o -> Bool -> m () setSearchBarShowCloseButton obj val = liftIO $ setObjectPropertyBool obj "show-close-button" val constructSearchBarShowCloseButton :: Bool -> IO ([Char], GValue) constructSearchBarShowCloseButton val = constructObjectPropertyBool "show-close-button" val data SearchBarShowCloseButtonPropertyInfo instance AttrInfo SearchBarShowCloseButtonPropertyInfo where type AttrAllowedOps SearchBarShowCloseButtonPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SearchBarShowCloseButtonPropertyInfo = (~) Bool type AttrBaseTypeConstraint SearchBarShowCloseButtonPropertyInfo = SearchBarK type AttrGetType SearchBarShowCloseButtonPropertyInfo = Bool type AttrLabel SearchBarShowCloseButtonPropertyInfo = "SearchBar::show-close-button" attrGet _ = getSearchBarShowCloseButton attrSet _ = setSearchBarShowCloseButton attrConstruct _ = constructSearchBarShowCloseButton type instance AttributeList SearchBar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("search-mode-enabled", SearchBarSearchModeEnabledPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-close-button", SearchBarShowCloseButtonPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList SearchEntry = '[ '("activates-default", EntryActivatesDefaultPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("attributes", EntryAttributesPropertyInfo), '("buffer", EntryBufferPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("caps-lock-warning", EntryCapsLockWarningPropertyInfo), '("completion", EntryCompletionPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("cursor-position", EntryCursorPositionPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("editable", EntryEditablePropertyInfo), '("editing-canceled", CellEditableEditingCanceledPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-frame", EntryHasFramePropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("im-module", EntryImModulePropertyInfo), '("inner-border", EntryInnerBorderPropertyInfo), '("input-hints", EntryInputHintsPropertyInfo), '("input-purpose", EntryInputPurposePropertyInfo), '("invisible-char", EntryInvisibleCharPropertyInfo), '("invisible-char-set", EntryInvisibleCharSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-length", EntryMaxLengthPropertyInfo), '("max-width-chars", EntryMaxWidthCharsPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("overwrite-mode", EntryOverwriteModePropertyInfo), '("parent", WidgetParentPropertyInfo), '("placeholder-text", EntryPlaceholderTextPropertyInfo), '("populate-all", EntryPopulateAllPropertyInfo), '("primary-icon-activatable", EntryPrimaryIconActivatablePropertyInfo), '("primary-icon-gicon", EntryPrimaryIconGiconPropertyInfo), '("primary-icon-name", EntryPrimaryIconNamePropertyInfo), '("primary-icon-pixbuf", EntryPrimaryIconPixbufPropertyInfo), '("primary-icon-sensitive", EntryPrimaryIconSensitivePropertyInfo), '("primary-icon-stock", EntryPrimaryIconStockPropertyInfo), '("primary-icon-storage-type", EntryPrimaryIconStorageTypePropertyInfo), '("primary-icon-tooltip-markup", EntryPrimaryIconTooltipMarkupPropertyInfo), '("primary-icon-tooltip-text", EntryPrimaryIconTooltipTextPropertyInfo), '("progress-fraction", EntryProgressFractionPropertyInfo), '("progress-pulse-step", EntryProgressPulseStepPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("scroll-offset", EntryScrollOffsetPropertyInfo), '("secondary-icon-activatable", EntrySecondaryIconActivatablePropertyInfo), '("secondary-icon-gicon", EntrySecondaryIconGiconPropertyInfo), '("secondary-icon-name", EntrySecondaryIconNamePropertyInfo), '("secondary-icon-pixbuf", EntrySecondaryIconPixbufPropertyInfo), '("secondary-icon-sensitive", EntrySecondaryIconSensitivePropertyInfo), '("secondary-icon-stock", EntrySecondaryIconStockPropertyInfo), '("secondary-icon-storage-type", EntrySecondaryIconStorageTypePropertyInfo), '("secondary-icon-tooltip-markup", EntrySecondaryIconTooltipMarkupPropertyInfo), '("secondary-icon-tooltip-text", EntrySecondaryIconTooltipTextPropertyInfo), '("selection-bound", EntrySelectionBoundPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", EntryShadowTypePropertyInfo), '("style", WidgetStylePropertyInfo), '("tabs", EntryTabsPropertyInfo), '("text", EntryTextPropertyInfo), '("text-length", EntryTextLengthPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("truncate-multiline", EntryTruncateMultilinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visibility", EntryVisibilityPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-chars", EntryWidthCharsPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", EntryXalignPropertyInfo)] type instance AttributeList Separator = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList SeparatorMenuItem = '[ '("accel-path", MenuItemAccelPathPropertyInfo), '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", MenuItemLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("right-justified", MenuItemRightJustifiedPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("submenu", MenuItemSubmenuPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-underline", MenuItemUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "draw" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSeparatorToolItemDraw :: (MonadIO m, SeparatorToolItemK o) => o -> m Bool getSeparatorToolItemDraw obj = liftIO $ getObjectPropertyBool obj "draw" setSeparatorToolItemDraw :: (MonadIO m, SeparatorToolItemK o) => o -> Bool -> m () setSeparatorToolItemDraw obj val = liftIO $ setObjectPropertyBool obj "draw" val constructSeparatorToolItemDraw :: Bool -> IO ([Char], GValue) constructSeparatorToolItemDraw val = constructObjectPropertyBool "draw" val data SeparatorToolItemDrawPropertyInfo instance AttrInfo SeparatorToolItemDrawPropertyInfo where type AttrAllowedOps SeparatorToolItemDrawPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SeparatorToolItemDrawPropertyInfo = (~) Bool type AttrBaseTypeConstraint SeparatorToolItemDrawPropertyInfo = SeparatorToolItemK type AttrGetType SeparatorToolItemDrawPropertyInfo = Bool type AttrLabel SeparatorToolItemDrawPropertyInfo = "SeparatorToolItem::draw" attrGet _ = getSeparatorToolItemDraw attrSet _ = setSeparatorToolItemDraw attrConstruct _ = constructSeparatorToolItemDraw type instance AttributeList SeparatorToolItem = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw", SeparatorToolItemDrawPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-important", ToolItemIsImportantPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("visible-horizontal", ToolItemVisibleHorizontalPropertyInfo), '("visible-vertical", ToolItemVisibleVerticalPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- XXX Generation of property "color-hash" of object "Settings" failed: Not implemented: "Property SettingsColorHash has unsupported transfer type TransferContainer" -- XXX Placeholder data SettingsColorHashPropertyInfo instance AttrInfo SettingsColorHashPropertyInfo where type AttrAllowedOps SettingsColorHashPropertyInfo = '[] type AttrSetTypeConstraint SettingsColorHashPropertyInfo = (~) () type AttrBaseTypeConstraint SettingsColorHashPropertyInfo = (~) () type AttrGetType SettingsColorHashPropertyInfo = () type AttrLabel SettingsColorHashPropertyInfo = "" attrGet = undefined attrSet = undefined attrConstruct = undefined -- VVV Prop "gtk-alternative-button-order" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkAlternativeButtonOrder :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkAlternativeButtonOrder obj = liftIO $ getObjectPropertyBool obj "gtk-alternative-button-order" setSettingsGtkAlternativeButtonOrder :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkAlternativeButtonOrder obj val = liftIO $ setObjectPropertyBool obj "gtk-alternative-button-order" val constructSettingsGtkAlternativeButtonOrder :: Bool -> IO ([Char], GValue) constructSettingsGtkAlternativeButtonOrder val = constructObjectPropertyBool "gtk-alternative-button-order" val data SettingsGtkAlternativeButtonOrderPropertyInfo instance AttrInfo SettingsGtkAlternativeButtonOrderPropertyInfo where type AttrAllowedOps SettingsGtkAlternativeButtonOrderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkAlternativeButtonOrderPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkAlternativeButtonOrderPropertyInfo = SettingsK type AttrGetType SettingsGtkAlternativeButtonOrderPropertyInfo = Bool type AttrLabel SettingsGtkAlternativeButtonOrderPropertyInfo = "Settings::gtk-alternative-button-order" attrGet _ = getSettingsGtkAlternativeButtonOrder attrSet _ = setSettingsGtkAlternativeButtonOrder attrConstruct _ = constructSettingsGtkAlternativeButtonOrder -- VVV Prop "gtk-alternative-sort-arrows" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkAlternativeSortArrows :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkAlternativeSortArrows obj = liftIO $ getObjectPropertyBool obj "gtk-alternative-sort-arrows" setSettingsGtkAlternativeSortArrows :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkAlternativeSortArrows obj val = liftIO $ setObjectPropertyBool obj "gtk-alternative-sort-arrows" val constructSettingsGtkAlternativeSortArrows :: Bool -> IO ([Char], GValue) constructSettingsGtkAlternativeSortArrows val = constructObjectPropertyBool "gtk-alternative-sort-arrows" val data SettingsGtkAlternativeSortArrowsPropertyInfo instance AttrInfo SettingsGtkAlternativeSortArrowsPropertyInfo where type AttrAllowedOps SettingsGtkAlternativeSortArrowsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkAlternativeSortArrowsPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkAlternativeSortArrowsPropertyInfo = SettingsK type AttrGetType SettingsGtkAlternativeSortArrowsPropertyInfo = Bool type AttrLabel SettingsGtkAlternativeSortArrowsPropertyInfo = "Settings::gtk-alternative-sort-arrows" attrGet _ = getSettingsGtkAlternativeSortArrows attrSet _ = setSettingsGtkAlternativeSortArrows attrConstruct _ = constructSettingsGtkAlternativeSortArrows -- VVV Prop "gtk-application-prefer-dark-theme" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkApplicationPreferDarkTheme :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkApplicationPreferDarkTheme obj = liftIO $ getObjectPropertyBool obj "gtk-application-prefer-dark-theme" setSettingsGtkApplicationPreferDarkTheme :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkApplicationPreferDarkTheme obj val = liftIO $ setObjectPropertyBool obj "gtk-application-prefer-dark-theme" val constructSettingsGtkApplicationPreferDarkTheme :: Bool -> IO ([Char], GValue) constructSettingsGtkApplicationPreferDarkTheme val = constructObjectPropertyBool "gtk-application-prefer-dark-theme" val data SettingsGtkApplicationPreferDarkThemePropertyInfo instance AttrInfo SettingsGtkApplicationPreferDarkThemePropertyInfo where type AttrAllowedOps SettingsGtkApplicationPreferDarkThemePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkApplicationPreferDarkThemePropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkApplicationPreferDarkThemePropertyInfo = SettingsK type AttrGetType SettingsGtkApplicationPreferDarkThemePropertyInfo = Bool type AttrLabel SettingsGtkApplicationPreferDarkThemePropertyInfo = "Settings::gtk-application-prefer-dark-theme" attrGet _ = getSettingsGtkApplicationPreferDarkTheme attrSet _ = setSettingsGtkApplicationPreferDarkTheme attrConstruct _ = constructSettingsGtkApplicationPreferDarkTheme -- VVV Prop "gtk-auto-mnemonics" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkAutoMnemonics :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkAutoMnemonics obj = liftIO $ getObjectPropertyBool obj "gtk-auto-mnemonics" setSettingsGtkAutoMnemonics :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkAutoMnemonics obj val = liftIO $ setObjectPropertyBool obj "gtk-auto-mnemonics" val constructSettingsGtkAutoMnemonics :: Bool -> IO ([Char], GValue) constructSettingsGtkAutoMnemonics val = constructObjectPropertyBool "gtk-auto-mnemonics" val data SettingsGtkAutoMnemonicsPropertyInfo instance AttrInfo SettingsGtkAutoMnemonicsPropertyInfo where type AttrAllowedOps SettingsGtkAutoMnemonicsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkAutoMnemonicsPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkAutoMnemonicsPropertyInfo = SettingsK type AttrGetType SettingsGtkAutoMnemonicsPropertyInfo = Bool type AttrLabel SettingsGtkAutoMnemonicsPropertyInfo = "Settings::gtk-auto-mnemonics" attrGet _ = getSettingsGtkAutoMnemonics attrSet _ = setSettingsGtkAutoMnemonics attrConstruct _ = constructSettingsGtkAutoMnemonics -- VVV Prop "gtk-button-images" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkButtonImages :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkButtonImages obj = liftIO $ getObjectPropertyBool obj "gtk-button-images" setSettingsGtkButtonImages :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkButtonImages obj val = liftIO $ setObjectPropertyBool obj "gtk-button-images" val constructSettingsGtkButtonImages :: Bool -> IO ([Char], GValue) constructSettingsGtkButtonImages val = constructObjectPropertyBool "gtk-button-images" val data SettingsGtkButtonImagesPropertyInfo instance AttrInfo SettingsGtkButtonImagesPropertyInfo where type AttrAllowedOps SettingsGtkButtonImagesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkButtonImagesPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkButtonImagesPropertyInfo = SettingsK type AttrGetType SettingsGtkButtonImagesPropertyInfo = Bool type AttrLabel SettingsGtkButtonImagesPropertyInfo = "Settings::gtk-button-images" attrGet _ = getSettingsGtkButtonImages attrSet _ = setSettingsGtkButtonImages attrConstruct _ = constructSettingsGtkButtonImages -- VVV Prop "gtk-can-change-accels" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkCanChangeAccels :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkCanChangeAccels obj = liftIO $ getObjectPropertyBool obj "gtk-can-change-accels" setSettingsGtkCanChangeAccels :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkCanChangeAccels obj val = liftIO $ setObjectPropertyBool obj "gtk-can-change-accels" val constructSettingsGtkCanChangeAccels :: Bool -> IO ([Char], GValue) constructSettingsGtkCanChangeAccels val = constructObjectPropertyBool "gtk-can-change-accels" val data SettingsGtkCanChangeAccelsPropertyInfo instance AttrInfo SettingsGtkCanChangeAccelsPropertyInfo where type AttrAllowedOps SettingsGtkCanChangeAccelsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkCanChangeAccelsPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkCanChangeAccelsPropertyInfo = SettingsK type AttrGetType SettingsGtkCanChangeAccelsPropertyInfo = Bool type AttrLabel SettingsGtkCanChangeAccelsPropertyInfo = "Settings::gtk-can-change-accels" attrGet _ = getSettingsGtkCanChangeAccels attrSet _ = setSettingsGtkCanChangeAccels attrConstruct _ = constructSettingsGtkCanChangeAccels -- VVV Prop "gtk-color-palette" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkColorPalette :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkColorPalette obj = liftIO $ getObjectPropertyString obj "gtk-color-palette" setSettingsGtkColorPalette :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkColorPalette obj val = liftIO $ setObjectPropertyString obj "gtk-color-palette" val constructSettingsGtkColorPalette :: T.Text -> IO ([Char], GValue) constructSettingsGtkColorPalette val = constructObjectPropertyString "gtk-color-palette" val data SettingsGtkColorPalettePropertyInfo instance AttrInfo SettingsGtkColorPalettePropertyInfo where type AttrAllowedOps SettingsGtkColorPalettePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkColorPalettePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkColorPalettePropertyInfo = SettingsK type AttrGetType SettingsGtkColorPalettePropertyInfo = T.Text type AttrLabel SettingsGtkColorPalettePropertyInfo = "Settings::gtk-color-palette" attrGet _ = getSettingsGtkColorPalette attrSet _ = setSettingsGtkColorPalette attrConstruct _ = constructSettingsGtkColorPalette -- VVV Prop "gtk-color-scheme" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkColorScheme :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkColorScheme obj = liftIO $ getObjectPropertyString obj "gtk-color-scheme" setSettingsGtkColorScheme :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkColorScheme obj val = liftIO $ setObjectPropertyString obj "gtk-color-scheme" val constructSettingsGtkColorScheme :: T.Text -> IO ([Char], GValue) constructSettingsGtkColorScheme val = constructObjectPropertyString "gtk-color-scheme" val data SettingsGtkColorSchemePropertyInfo instance AttrInfo SettingsGtkColorSchemePropertyInfo where type AttrAllowedOps SettingsGtkColorSchemePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkColorSchemePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkColorSchemePropertyInfo = SettingsK type AttrGetType SettingsGtkColorSchemePropertyInfo = T.Text type AttrLabel SettingsGtkColorSchemePropertyInfo = "Settings::gtk-color-scheme" attrGet _ = getSettingsGtkColorScheme attrSet _ = setSettingsGtkColorScheme attrConstruct _ = constructSettingsGtkColorScheme -- VVV Prop "gtk-cursor-blink" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkCursorBlink :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkCursorBlink obj = liftIO $ getObjectPropertyBool obj "gtk-cursor-blink" setSettingsGtkCursorBlink :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkCursorBlink obj val = liftIO $ setObjectPropertyBool obj "gtk-cursor-blink" val constructSettingsGtkCursorBlink :: Bool -> IO ([Char], GValue) constructSettingsGtkCursorBlink val = constructObjectPropertyBool "gtk-cursor-blink" val data SettingsGtkCursorBlinkPropertyInfo instance AttrInfo SettingsGtkCursorBlinkPropertyInfo where type AttrAllowedOps SettingsGtkCursorBlinkPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkCursorBlinkPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkCursorBlinkPropertyInfo = SettingsK type AttrGetType SettingsGtkCursorBlinkPropertyInfo = Bool type AttrLabel SettingsGtkCursorBlinkPropertyInfo = "Settings::gtk-cursor-blink" attrGet _ = getSettingsGtkCursorBlink attrSet _ = setSettingsGtkCursorBlink attrConstruct _ = constructSettingsGtkCursorBlink -- VVV Prop "gtk-cursor-blink-time" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkCursorBlinkTime :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkCursorBlinkTime obj = liftIO $ getObjectPropertyCInt obj "gtk-cursor-blink-time" setSettingsGtkCursorBlinkTime :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkCursorBlinkTime obj val = liftIO $ setObjectPropertyCInt obj "gtk-cursor-blink-time" val constructSettingsGtkCursorBlinkTime :: Int32 -> IO ([Char], GValue) constructSettingsGtkCursorBlinkTime val = constructObjectPropertyCInt "gtk-cursor-blink-time" val data SettingsGtkCursorBlinkTimePropertyInfo instance AttrInfo SettingsGtkCursorBlinkTimePropertyInfo where type AttrAllowedOps SettingsGtkCursorBlinkTimePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkCursorBlinkTimePropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkCursorBlinkTimePropertyInfo = SettingsK type AttrGetType SettingsGtkCursorBlinkTimePropertyInfo = Int32 type AttrLabel SettingsGtkCursorBlinkTimePropertyInfo = "Settings::gtk-cursor-blink-time" attrGet _ = getSettingsGtkCursorBlinkTime attrSet _ = setSettingsGtkCursorBlinkTime attrConstruct _ = constructSettingsGtkCursorBlinkTime -- VVV Prop "gtk-cursor-blink-timeout" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkCursorBlinkTimeout :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkCursorBlinkTimeout obj = liftIO $ getObjectPropertyCInt obj "gtk-cursor-blink-timeout" setSettingsGtkCursorBlinkTimeout :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkCursorBlinkTimeout obj val = liftIO $ setObjectPropertyCInt obj "gtk-cursor-blink-timeout" val constructSettingsGtkCursorBlinkTimeout :: Int32 -> IO ([Char], GValue) constructSettingsGtkCursorBlinkTimeout val = constructObjectPropertyCInt "gtk-cursor-blink-timeout" val data SettingsGtkCursorBlinkTimeoutPropertyInfo instance AttrInfo SettingsGtkCursorBlinkTimeoutPropertyInfo where type AttrAllowedOps SettingsGtkCursorBlinkTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkCursorBlinkTimeoutPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkCursorBlinkTimeoutPropertyInfo = SettingsK type AttrGetType SettingsGtkCursorBlinkTimeoutPropertyInfo = Int32 type AttrLabel SettingsGtkCursorBlinkTimeoutPropertyInfo = "Settings::gtk-cursor-blink-timeout" attrGet _ = getSettingsGtkCursorBlinkTimeout attrSet _ = setSettingsGtkCursorBlinkTimeout attrConstruct _ = constructSettingsGtkCursorBlinkTimeout -- VVV Prop "gtk-cursor-theme-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkCursorThemeName :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkCursorThemeName obj = liftIO $ getObjectPropertyString obj "gtk-cursor-theme-name" setSettingsGtkCursorThemeName :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkCursorThemeName obj val = liftIO $ setObjectPropertyString obj "gtk-cursor-theme-name" val constructSettingsGtkCursorThemeName :: T.Text -> IO ([Char], GValue) constructSettingsGtkCursorThemeName val = constructObjectPropertyString "gtk-cursor-theme-name" val data SettingsGtkCursorThemeNamePropertyInfo instance AttrInfo SettingsGtkCursorThemeNamePropertyInfo where type AttrAllowedOps SettingsGtkCursorThemeNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkCursorThemeNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkCursorThemeNamePropertyInfo = SettingsK type AttrGetType SettingsGtkCursorThemeNamePropertyInfo = T.Text type AttrLabel SettingsGtkCursorThemeNamePropertyInfo = "Settings::gtk-cursor-theme-name" attrGet _ = getSettingsGtkCursorThemeName attrSet _ = setSettingsGtkCursorThemeName attrConstruct _ = constructSettingsGtkCursorThemeName -- VVV Prop "gtk-cursor-theme-size" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkCursorThemeSize :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkCursorThemeSize obj = liftIO $ getObjectPropertyCInt obj "gtk-cursor-theme-size" setSettingsGtkCursorThemeSize :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkCursorThemeSize obj val = liftIO $ setObjectPropertyCInt obj "gtk-cursor-theme-size" val constructSettingsGtkCursorThemeSize :: Int32 -> IO ([Char], GValue) constructSettingsGtkCursorThemeSize val = constructObjectPropertyCInt "gtk-cursor-theme-size" val data SettingsGtkCursorThemeSizePropertyInfo instance AttrInfo SettingsGtkCursorThemeSizePropertyInfo where type AttrAllowedOps SettingsGtkCursorThemeSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkCursorThemeSizePropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkCursorThemeSizePropertyInfo = SettingsK type AttrGetType SettingsGtkCursorThemeSizePropertyInfo = Int32 type AttrLabel SettingsGtkCursorThemeSizePropertyInfo = "Settings::gtk-cursor-theme-size" attrGet _ = getSettingsGtkCursorThemeSize attrSet _ = setSettingsGtkCursorThemeSize attrConstruct _ = constructSettingsGtkCursorThemeSize -- VVV Prop "gtk-decoration-layout" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkDecorationLayout :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkDecorationLayout obj = liftIO $ getObjectPropertyString obj "gtk-decoration-layout" setSettingsGtkDecorationLayout :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkDecorationLayout obj val = liftIO $ setObjectPropertyString obj "gtk-decoration-layout" val constructSettingsGtkDecorationLayout :: T.Text -> IO ([Char], GValue) constructSettingsGtkDecorationLayout val = constructObjectPropertyString "gtk-decoration-layout" val data SettingsGtkDecorationLayoutPropertyInfo instance AttrInfo SettingsGtkDecorationLayoutPropertyInfo where type AttrAllowedOps SettingsGtkDecorationLayoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkDecorationLayoutPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkDecorationLayoutPropertyInfo = SettingsK type AttrGetType SettingsGtkDecorationLayoutPropertyInfo = T.Text type AttrLabel SettingsGtkDecorationLayoutPropertyInfo = "Settings::gtk-decoration-layout" attrGet _ = getSettingsGtkDecorationLayout attrSet _ = setSettingsGtkDecorationLayout attrConstruct _ = constructSettingsGtkDecorationLayout -- VVV Prop "gtk-dialogs-use-header" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkDialogsUseHeader :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkDialogsUseHeader obj = liftIO $ getObjectPropertyBool obj "gtk-dialogs-use-header" setSettingsGtkDialogsUseHeader :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkDialogsUseHeader obj val = liftIO $ setObjectPropertyBool obj "gtk-dialogs-use-header" val constructSettingsGtkDialogsUseHeader :: Bool -> IO ([Char], GValue) constructSettingsGtkDialogsUseHeader val = constructObjectPropertyBool "gtk-dialogs-use-header" val data SettingsGtkDialogsUseHeaderPropertyInfo instance AttrInfo SettingsGtkDialogsUseHeaderPropertyInfo where type AttrAllowedOps SettingsGtkDialogsUseHeaderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkDialogsUseHeaderPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkDialogsUseHeaderPropertyInfo = SettingsK type AttrGetType SettingsGtkDialogsUseHeaderPropertyInfo = Bool type AttrLabel SettingsGtkDialogsUseHeaderPropertyInfo = "Settings::gtk-dialogs-use-header" attrGet _ = getSettingsGtkDialogsUseHeader attrSet _ = setSettingsGtkDialogsUseHeader attrConstruct _ = constructSettingsGtkDialogsUseHeader -- VVV Prop "gtk-dnd-drag-threshold" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkDndDragThreshold :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkDndDragThreshold obj = liftIO $ getObjectPropertyCInt obj "gtk-dnd-drag-threshold" setSettingsGtkDndDragThreshold :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkDndDragThreshold obj val = liftIO $ setObjectPropertyCInt obj "gtk-dnd-drag-threshold" val constructSettingsGtkDndDragThreshold :: Int32 -> IO ([Char], GValue) constructSettingsGtkDndDragThreshold val = constructObjectPropertyCInt "gtk-dnd-drag-threshold" val data SettingsGtkDndDragThresholdPropertyInfo instance AttrInfo SettingsGtkDndDragThresholdPropertyInfo where type AttrAllowedOps SettingsGtkDndDragThresholdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkDndDragThresholdPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkDndDragThresholdPropertyInfo = SettingsK type AttrGetType SettingsGtkDndDragThresholdPropertyInfo = Int32 type AttrLabel SettingsGtkDndDragThresholdPropertyInfo = "Settings::gtk-dnd-drag-threshold" attrGet _ = getSettingsGtkDndDragThreshold attrSet _ = setSettingsGtkDndDragThreshold attrConstruct _ = constructSettingsGtkDndDragThreshold -- VVV Prop "gtk-double-click-distance" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkDoubleClickDistance :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkDoubleClickDistance obj = liftIO $ getObjectPropertyCInt obj "gtk-double-click-distance" setSettingsGtkDoubleClickDistance :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkDoubleClickDistance obj val = liftIO $ setObjectPropertyCInt obj "gtk-double-click-distance" val constructSettingsGtkDoubleClickDistance :: Int32 -> IO ([Char], GValue) constructSettingsGtkDoubleClickDistance val = constructObjectPropertyCInt "gtk-double-click-distance" val data SettingsGtkDoubleClickDistancePropertyInfo instance AttrInfo SettingsGtkDoubleClickDistancePropertyInfo where type AttrAllowedOps SettingsGtkDoubleClickDistancePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkDoubleClickDistancePropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkDoubleClickDistancePropertyInfo = SettingsK type AttrGetType SettingsGtkDoubleClickDistancePropertyInfo = Int32 type AttrLabel SettingsGtkDoubleClickDistancePropertyInfo = "Settings::gtk-double-click-distance" attrGet _ = getSettingsGtkDoubleClickDistance attrSet _ = setSettingsGtkDoubleClickDistance attrConstruct _ = constructSettingsGtkDoubleClickDistance -- VVV Prop "gtk-double-click-time" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkDoubleClickTime :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkDoubleClickTime obj = liftIO $ getObjectPropertyCInt obj "gtk-double-click-time" setSettingsGtkDoubleClickTime :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkDoubleClickTime obj val = liftIO $ setObjectPropertyCInt obj "gtk-double-click-time" val constructSettingsGtkDoubleClickTime :: Int32 -> IO ([Char], GValue) constructSettingsGtkDoubleClickTime val = constructObjectPropertyCInt "gtk-double-click-time" val data SettingsGtkDoubleClickTimePropertyInfo instance AttrInfo SettingsGtkDoubleClickTimePropertyInfo where type AttrAllowedOps SettingsGtkDoubleClickTimePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkDoubleClickTimePropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkDoubleClickTimePropertyInfo = SettingsK type AttrGetType SettingsGtkDoubleClickTimePropertyInfo = Int32 type AttrLabel SettingsGtkDoubleClickTimePropertyInfo = "Settings::gtk-double-click-time" attrGet _ = getSettingsGtkDoubleClickTime attrSet _ = setSettingsGtkDoubleClickTime attrConstruct _ = constructSettingsGtkDoubleClickTime -- VVV Prop "gtk-enable-accels" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkEnableAccels :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkEnableAccels obj = liftIO $ getObjectPropertyBool obj "gtk-enable-accels" setSettingsGtkEnableAccels :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkEnableAccels obj val = liftIO $ setObjectPropertyBool obj "gtk-enable-accels" val constructSettingsGtkEnableAccels :: Bool -> IO ([Char], GValue) constructSettingsGtkEnableAccels val = constructObjectPropertyBool "gtk-enable-accels" val data SettingsGtkEnableAccelsPropertyInfo instance AttrInfo SettingsGtkEnableAccelsPropertyInfo where type AttrAllowedOps SettingsGtkEnableAccelsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkEnableAccelsPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkEnableAccelsPropertyInfo = SettingsK type AttrGetType SettingsGtkEnableAccelsPropertyInfo = Bool type AttrLabel SettingsGtkEnableAccelsPropertyInfo = "Settings::gtk-enable-accels" attrGet _ = getSettingsGtkEnableAccels attrSet _ = setSettingsGtkEnableAccels attrConstruct _ = constructSettingsGtkEnableAccels -- VVV Prop "gtk-enable-animations" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkEnableAnimations :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkEnableAnimations obj = liftIO $ getObjectPropertyBool obj "gtk-enable-animations" setSettingsGtkEnableAnimations :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkEnableAnimations obj val = liftIO $ setObjectPropertyBool obj "gtk-enable-animations" val constructSettingsGtkEnableAnimations :: Bool -> IO ([Char], GValue) constructSettingsGtkEnableAnimations val = constructObjectPropertyBool "gtk-enable-animations" val data SettingsGtkEnableAnimationsPropertyInfo instance AttrInfo SettingsGtkEnableAnimationsPropertyInfo where type AttrAllowedOps SettingsGtkEnableAnimationsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkEnableAnimationsPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkEnableAnimationsPropertyInfo = SettingsK type AttrGetType SettingsGtkEnableAnimationsPropertyInfo = Bool type AttrLabel SettingsGtkEnableAnimationsPropertyInfo = "Settings::gtk-enable-animations" attrGet _ = getSettingsGtkEnableAnimations attrSet _ = setSettingsGtkEnableAnimations attrConstruct _ = constructSettingsGtkEnableAnimations -- VVV Prop "gtk-enable-event-sounds" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkEnableEventSounds :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkEnableEventSounds obj = liftIO $ getObjectPropertyBool obj "gtk-enable-event-sounds" setSettingsGtkEnableEventSounds :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkEnableEventSounds obj val = liftIO $ setObjectPropertyBool obj "gtk-enable-event-sounds" val constructSettingsGtkEnableEventSounds :: Bool -> IO ([Char], GValue) constructSettingsGtkEnableEventSounds val = constructObjectPropertyBool "gtk-enable-event-sounds" val data SettingsGtkEnableEventSoundsPropertyInfo instance AttrInfo SettingsGtkEnableEventSoundsPropertyInfo where type AttrAllowedOps SettingsGtkEnableEventSoundsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkEnableEventSoundsPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkEnableEventSoundsPropertyInfo = SettingsK type AttrGetType SettingsGtkEnableEventSoundsPropertyInfo = Bool type AttrLabel SettingsGtkEnableEventSoundsPropertyInfo = "Settings::gtk-enable-event-sounds" attrGet _ = getSettingsGtkEnableEventSounds attrSet _ = setSettingsGtkEnableEventSounds attrConstruct _ = constructSettingsGtkEnableEventSounds -- VVV Prop "gtk-enable-input-feedback-sounds" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkEnableInputFeedbackSounds :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkEnableInputFeedbackSounds obj = liftIO $ getObjectPropertyBool obj "gtk-enable-input-feedback-sounds" setSettingsGtkEnableInputFeedbackSounds :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkEnableInputFeedbackSounds obj val = liftIO $ setObjectPropertyBool obj "gtk-enable-input-feedback-sounds" val constructSettingsGtkEnableInputFeedbackSounds :: Bool -> IO ([Char], GValue) constructSettingsGtkEnableInputFeedbackSounds val = constructObjectPropertyBool "gtk-enable-input-feedback-sounds" val data SettingsGtkEnableInputFeedbackSoundsPropertyInfo instance AttrInfo SettingsGtkEnableInputFeedbackSoundsPropertyInfo where type AttrAllowedOps SettingsGtkEnableInputFeedbackSoundsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkEnableInputFeedbackSoundsPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkEnableInputFeedbackSoundsPropertyInfo = SettingsK type AttrGetType SettingsGtkEnableInputFeedbackSoundsPropertyInfo = Bool type AttrLabel SettingsGtkEnableInputFeedbackSoundsPropertyInfo = "Settings::gtk-enable-input-feedback-sounds" attrGet _ = getSettingsGtkEnableInputFeedbackSounds attrSet _ = setSettingsGtkEnableInputFeedbackSounds attrConstruct _ = constructSettingsGtkEnableInputFeedbackSounds -- VVV Prop "gtk-enable-mnemonics" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkEnableMnemonics :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkEnableMnemonics obj = liftIO $ getObjectPropertyBool obj "gtk-enable-mnemonics" setSettingsGtkEnableMnemonics :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkEnableMnemonics obj val = liftIO $ setObjectPropertyBool obj "gtk-enable-mnemonics" val constructSettingsGtkEnableMnemonics :: Bool -> IO ([Char], GValue) constructSettingsGtkEnableMnemonics val = constructObjectPropertyBool "gtk-enable-mnemonics" val data SettingsGtkEnableMnemonicsPropertyInfo instance AttrInfo SettingsGtkEnableMnemonicsPropertyInfo where type AttrAllowedOps SettingsGtkEnableMnemonicsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkEnableMnemonicsPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkEnableMnemonicsPropertyInfo = SettingsK type AttrGetType SettingsGtkEnableMnemonicsPropertyInfo = Bool type AttrLabel SettingsGtkEnableMnemonicsPropertyInfo = "Settings::gtk-enable-mnemonics" attrGet _ = getSettingsGtkEnableMnemonics attrSet _ = setSettingsGtkEnableMnemonics attrConstruct _ = constructSettingsGtkEnableMnemonics -- VVV Prop "gtk-enable-primary-paste" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkEnablePrimaryPaste :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkEnablePrimaryPaste obj = liftIO $ getObjectPropertyBool obj "gtk-enable-primary-paste" setSettingsGtkEnablePrimaryPaste :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkEnablePrimaryPaste obj val = liftIO $ setObjectPropertyBool obj "gtk-enable-primary-paste" val constructSettingsGtkEnablePrimaryPaste :: Bool -> IO ([Char], GValue) constructSettingsGtkEnablePrimaryPaste val = constructObjectPropertyBool "gtk-enable-primary-paste" val data SettingsGtkEnablePrimaryPastePropertyInfo instance AttrInfo SettingsGtkEnablePrimaryPastePropertyInfo where type AttrAllowedOps SettingsGtkEnablePrimaryPastePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkEnablePrimaryPastePropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkEnablePrimaryPastePropertyInfo = SettingsK type AttrGetType SettingsGtkEnablePrimaryPastePropertyInfo = Bool type AttrLabel SettingsGtkEnablePrimaryPastePropertyInfo = "Settings::gtk-enable-primary-paste" attrGet _ = getSettingsGtkEnablePrimaryPaste attrSet _ = setSettingsGtkEnablePrimaryPaste attrConstruct _ = constructSettingsGtkEnablePrimaryPaste -- VVV Prop "gtk-enable-tooltips" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkEnableTooltips :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkEnableTooltips obj = liftIO $ getObjectPropertyBool obj "gtk-enable-tooltips" setSettingsGtkEnableTooltips :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkEnableTooltips obj val = liftIO $ setObjectPropertyBool obj "gtk-enable-tooltips" val constructSettingsGtkEnableTooltips :: Bool -> IO ([Char], GValue) constructSettingsGtkEnableTooltips val = constructObjectPropertyBool "gtk-enable-tooltips" val data SettingsGtkEnableTooltipsPropertyInfo instance AttrInfo SettingsGtkEnableTooltipsPropertyInfo where type AttrAllowedOps SettingsGtkEnableTooltipsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkEnableTooltipsPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkEnableTooltipsPropertyInfo = SettingsK type AttrGetType SettingsGtkEnableTooltipsPropertyInfo = Bool type AttrLabel SettingsGtkEnableTooltipsPropertyInfo = "Settings::gtk-enable-tooltips" attrGet _ = getSettingsGtkEnableTooltips attrSet _ = setSettingsGtkEnableTooltips attrConstruct _ = constructSettingsGtkEnableTooltips -- VVV Prop "gtk-entry-password-hint-timeout" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkEntryPasswordHintTimeout :: (MonadIO m, SettingsK o) => o -> m Word32 getSettingsGtkEntryPasswordHintTimeout obj = liftIO $ getObjectPropertyCUInt obj "gtk-entry-password-hint-timeout" setSettingsGtkEntryPasswordHintTimeout :: (MonadIO m, SettingsK o) => o -> Word32 -> m () setSettingsGtkEntryPasswordHintTimeout obj val = liftIO $ setObjectPropertyCUInt obj "gtk-entry-password-hint-timeout" val constructSettingsGtkEntryPasswordHintTimeout :: Word32 -> IO ([Char], GValue) constructSettingsGtkEntryPasswordHintTimeout val = constructObjectPropertyCUInt "gtk-entry-password-hint-timeout" val data SettingsGtkEntryPasswordHintTimeoutPropertyInfo instance AttrInfo SettingsGtkEntryPasswordHintTimeoutPropertyInfo where type AttrAllowedOps SettingsGtkEntryPasswordHintTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkEntryPasswordHintTimeoutPropertyInfo = (~) Word32 type AttrBaseTypeConstraint SettingsGtkEntryPasswordHintTimeoutPropertyInfo = SettingsK type AttrGetType SettingsGtkEntryPasswordHintTimeoutPropertyInfo = Word32 type AttrLabel SettingsGtkEntryPasswordHintTimeoutPropertyInfo = "Settings::gtk-entry-password-hint-timeout" attrGet _ = getSettingsGtkEntryPasswordHintTimeout attrSet _ = setSettingsGtkEntryPasswordHintTimeout attrConstruct _ = constructSettingsGtkEntryPasswordHintTimeout -- VVV Prop "gtk-entry-select-on-focus" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkEntrySelectOnFocus :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkEntrySelectOnFocus obj = liftIO $ getObjectPropertyBool obj "gtk-entry-select-on-focus" setSettingsGtkEntrySelectOnFocus :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkEntrySelectOnFocus obj val = liftIO $ setObjectPropertyBool obj "gtk-entry-select-on-focus" val constructSettingsGtkEntrySelectOnFocus :: Bool -> IO ([Char], GValue) constructSettingsGtkEntrySelectOnFocus val = constructObjectPropertyBool "gtk-entry-select-on-focus" val data SettingsGtkEntrySelectOnFocusPropertyInfo instance AttrInfo SettingsGtkEntrySelectOnFocusPropertyInfo where type AttrAllowedOps SettingsGtkEntrySelectOnFocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkEntrySelectOnFocusPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkEntrySelectOnFocusPropertyInfo = SettingsK type AttrGetType SettingsGtkEntrySelectOnFocusPropertyInfo = Bool type AttrLabel SettingsGtkEntrySelectOnFocusPropertyInfo = "Settings::gtk-entry-select-on-focus" attrGet _ = getSettingsGtkEntrySelectOnFocus attrSet _ = setSettingsGtkEntrySelectOnFocus attrConstruct _ = constructSettingsGtkEntrySelectOnFocus -- VVV Prop "gtk-error-bell" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkErrorBell :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkErrorBell obj = liftIO $ getObjectPropertyBool obj "gtk-error-bell" setSettingsGtkErrorBell :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkErrorBell obj val = liftIO $ setObjectPropertyBool obj "gtk-error-bell" val constructSettingsGtkErrorBell :: Bool -> IO ([Char], GValue) constructSettingsGtkErrorBell val = constructObjectPropertyBool "gtk-error-bell" val data SettingsGtkErrorBellPropertyInfo instance AttrInfo SettingsGtkErrorBellPropertyInfo where type AttrAllowedOps SettingsGtkErrorBellPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkErrorBellPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkErrorBellPropertyInfo = SettingsK type AttrGetType SettingsGtkErrorBellPropertyInfo = Bool type AttrLabel SettingsGtkErrorBellPropertyInfo = "Settings::gtk-error-bell" attrGet _ = getSettingsGtkErrorBell attrSet _ = setSettingsGtkErrorBell attrConstruct _ = constructSettingsGtkErrorBell -- VVV Prop "gtk-fallback-icon-theme" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkFallbackIconTheme :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkFallbackIconTheme obj = liftIO $ getObjectPropertyString obj "gtk-fallback-icon-theme" setSettingsGtkFallbackIconTheme :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkFallbackIconTheme obj val = liftIO $ setObjectPropertyString obj "gtk-fallback-icon-theme" val constructSettingsGtkFallbackIconTheme :: T.Text -> IO ([Char], GValue) constructSettingsGtkFallbackIconTheme val = constructObjectPropertyString "gtk-fallback-icon-theme" val data SettingsGtkFallbackIconThemePropertyInfo instance AttrInfo SettingsGtkFallbackIconThemePropertyInfo where type AttrAllowedOps SettingsGtkFallbackIconThemePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkFallbackIconThemePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkFallbackIconThemePropertyInfo = SettingsK type AttrGetType SettingsGtkFallbackIconThemePropertyInfo = T.Text type AttrLabel SettingsGtkFallbackIconThemePropertyInfo = "Settings::gtk-fallback-icon-theme" attrGet _ = getSettingsGtkFallbackIconTheme attrSet _ = setSettingsGtkFallbackIconTheme attrConstruct _ = constructSettingsGtkFallbackIconTheme -- VVV Prop "gtk-file-chooser-backend" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkFileChooserBackend :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkFileChooserBackend obj = liftIO $ getObjectPropertyString obj "gtk-file-chooser-backend" setSettingsGtkFileChooserBackend :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkFileChooserBackend obj val = liftIO $ setObjectPropertyString obj "gtk-file-chooser-backend" val constructSettingsGtkFileChooserBackend :: T.Text -> IO ([Char], GValue) constructSettingsGtkFileChooserBackend val = constructObjectPropertyString "gtk-file-chooser-backend" val data SettingsGtkFileChooserBackendPropertyInfo instance AttrInfo SettingsGtkFileChooserBackendPropertyInfo where type AttrAllowedOps SettingsGtkFileChooserBackendPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkFileChooserBackendPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkFileChooserBackendPropertyInfo = SettingsK type AttrGetType SettingsGtkFileChooserBackendPropertyInfo = T.Text type AttrLabel SettingsGtkFileChooserBackendPropertyInfo = "Settings::gtk-file-chooser-backend" attrGet _ = getSettingsGtkFileChooserBackend attrSet _ = setSettingsGtkFileChooserBackend attrConstruct _ = constructSettingsGtkFileChooserBackend -- VVV Prop "gtk-font-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkFontName :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkFontName obj = liftIO $ getObjectPropertyString obj "gtk-font-name" setSettingsGtkFontName :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkFontName obj val = liftIO $ setObjectPropertyString obj "gtk-font-name" val constructSettingsGtkFontName :: T.Text -> IO ([Char], GValue) constructSettingsGtkFontName val = constructObjectPropertyString "gtk-font-name" val data SettingsGtkFontNamePropertyInfo instance AttrInfo SettingsGtkFontNamePropertyInfo where type AttrAllowedOps SettingsGtkFontNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkFontNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkFontNamePropertyInfo = SettingsK type AttrGetType SettingsGtkFontNamePropertyInfo = T.Text type AttrLabel SettingsGtkFontNamePropertyInfo = "Settings::gtk-font-name" attrGet _ = getSettingsGtkFontName attrSet _ = setSettingsGtkFontName attrConstruct _ = constructSettingsGtkFontName -- VVV Prop "gtk-fontconfig-timestamp" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkFontconfigTimestamp :: (MonadIO m, SettingsK o) => o -> m Word32 getSettingsGtkFontconfigTimestamp obj = liftIO $ getObjectPropertyCUInt obj "gtk-fontconfig-timestamp" setSettingsGtkFontconfigTimestamp :: (MonadIO m, SettingsK o) => o -> Word32 -> m () setSettingsGtkFontconfigTimestamp obj val = liftIO $ setObjectPropertyCUInt obj "gtk-fontconfig-timestamp" val constructSettingsGtkFontconfigTimestamp :: Word32 -> IO ([Char], GValue) constructSettingsGtkFontconfigTimestamp val = constructObjectPropertyCUInt "gtk-fontconfig-timestamp" val data SettingsGtkFontconfigTimestampPropertyInfo instance AttrInfo SettingsGtkFontconfigTimestampPropertyInfo where type AttrAllowedOps SettingsGtkFontconfigTimestampPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkFontconfigTimestampPropertyInfo = (~) Word32 type AttrBaseTypeConstraint SettingsGtkFontconfigTimestampPropertyInfo = SettingsK type AttrGetType SettingsGtkFontconfigTimestampPropertyInfo = Word32 type AttrLabel SettingsGtkFontconfigTimestampPropertyInfo = "Settings::gtk-fontconfig-timestamp" attrGet _ = getSettingsGtkFontconfigTimestamp attrSet _ = setSettingsGtkFontconfigTimestamp attrConstruct _ = constructSettingsGtkFontconfigTimestamp -- VVV Prop "gtk-icon-sizes" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkIconSizes :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkIconSizes obj = liftIO $ getObjectPropertyString obj "gtk-icon-sizes" setSettingsGtkIconSizes :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkIconSizes obj val = liftIO $ setObjectPropertyString obj "gtk-icon-sizes" val constructSettingsGtkIconSizes :: T.Text -> IO ([Char], GValue) constructSettingsGtkIconSizes val = constructObjectPropertyString "gtk-icon-sizes" val data SettingsGtkIconSizesPropertyInfo instance AttrInfo SettingsGtkIconSizesPropertyInfo where type AttrAllowedOps SettingsGtkIconSizesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkIconSizesPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkIconSizesPropertyInfo = SettingsK type AttrGetType SettingsGtkIconSizesPropertyInfo = T.Text type AttrLabel SettingsGtkIconSizesPropertyInfo = "Settings::gtk-icon-sizes" attrGet _ = getSettingsGtkIconSizes attrSet _ = setSettingsGtkIconSizes attrConstruct _ = constructSettingsGtkIconSizes -- VVV Prop "gtk-icon-theme-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkIconThemeName :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkIconThemeName obj = liftIO $ getObjectPropertyString obj "gtk-icon-theme-name" setSettingsGtkIconThemeName :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkIconThemeName obj val = liftIO $ setObjectPropertyString obj "gtk-icon-theme-name" val constructSettingsGtkIconThemeName :: T.Text -> IO ([Char], GValue) constructSettingsGtkIconThemeName val = constructObjectPropertyString "gtk-icon-theme-name" val data SettingsGtkIconThemeNamePropertyInfo instance AttrInfo SettingsGtkIconThemeNamePropertyInfo where type AttrAllowedOps SettingsGtkIconThemeNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkIconThemeNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkIconThemeNamePropertyInfo = SettingsK type AttrGetType SettingsGtkIconThemeNamePropertyInfo = T.Text type AttrLabel SettingsGtkIconThemeNamePropertyInfo = "Settings::gtk-icon-theme-name" attrGet _ = getSettingsGtkIconThemeName attrSet _ = setSettingsGtkIconThemeName attrConstruct _ = constructSettingsGtkIconThemeName -- VVV Prop "gtk-im-module" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkImModule :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkImModule obj = liftIO $ getObjectPropertyString obj "gtk-im-module" setSettingsGtkImModule :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkImModule obj val = liftIO $ setObjectPropertyString obj "gtk-im-module" val constructSettingsGtkImModule :: T.Text -> IO ([Char], GValue) constructSettingsGtkImModule val = constructObjectPropertyString "gtk-im-module" val data SettingsGtkImModulePropertyInfo instance AttrInfo SettingsGtkImModulePropertyInfo where type AttrAllowedOps SettingsGtkImModulePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkImModulePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkImModulePropertyInfo = SettingsK type AttrGetType SettingsGtkImModulePropertyInfo = T.Text type AttrLabel SettingsGtkImModulePropertyInfo = "Settings::gtk-im-module" attrGet _ = getSettingsGtkImModule attrSet _ = setSettingsGtkImModule attrConstruct _ = constructSettingsGtkImModule -- VVV Prop "gtk-im-preedit-style" -- Type: TInterface "Gtk" "IMPreeditStyle" -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkImPreeditStyle :: (MonadIO m, SettingsK o) => o -> m IMPreeditStyle getSettingsGtkImPreeditStyle obj = liftIO $ getObjectPropertyEnum obj "gtk-im-preedit-style" setSettingsGtkImPreeditStyle :: (MonadIO m, SettingsK o) => o -> IMPreeditStyle -> m () setSettingsGtkImPreeditStyle obj val = liftIO $ setObjectPropertyEnum obj "gtk-im-preedit-style" val constructSettingsGtkImPreeditStyle :: IMPreeditStyle -> IO ([Char], GValue) constructSettingsGtkImPreeditStyle val = constructObjectPropertyEnum "gtk-im-preedit-style" val data SettingsGtkImPreeditStylePropertyInfo instance AttrInfo SettingsGtkImPreeditStylePropertyInfo where type AttrAllowedOps SettingsGtkImPreeditStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkImPreeditStylePropertyInfo = (~) IMPreeditStyle type AttrBaseTypeConstraint SettingsGtkImPreeditStylePropertyInfo = SettingsK type AttrGetType SettingsGtkImPreeditStylePropertyInfo = IMPreeditStyle type AttrLabel SettingsGtkImPreeditStylePropertyInfo = "Settings::gtk-im-preedit-style" attrGet _ = getSettingsGtkImPreeditStyle attrSet _ = setSettingsGtkImPreeditStyle attrConstruct _ = constructSettingsGtkImPreeditStyle -- VVV Prop "gtk-im-status-style" -- Type: TInterface "Gtk" "IMStatusStyle" -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkImStatusStyle :: (MonadIO m, SettingsK o) => o -> m IMStatusStyle getSettingsGtkImStatusStyle obj = liftIO $ getObjectPropertyEnum obj "gtk-im-status-style" setSettingsGtkImStatusStyle :: (MonadIO m, SettingsK o) => o -> IMStatusStyle -> m () setSettingsGtkImStatusStyle obj val = liftIO $ setObjectPropertyEnum obj "gtk-im-status-style" val constructSettingsGtkImStatusStyle :: IMStatusStyle -> IO ([Char], GValue) constructSettingsGtkImStatusStyle val = constructObjectPropertyEnum "gtk-im-status-style" val data SettingsGtkImStatusStylePropertyInfo instance AttrInfo SettingsGtkImStatusStylePropertyInfo where type AttrAllowedOps SettingsGtkImStatusStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkImStatusStylePropertyInfo = (~) IMStatusStyle type AttrBaseTypeConstraint SettingsGtkImStatusStylePropertyInfo = SettingsK type AttrGetType SettingsGtkImStatusStylePropertyInfo = IMStatusStyle type AttrLabel SettingsGtkImStatusStylePropertyInfo = "Settings::gtk-im-status-style" attrGet _ = getSettingsGtkImStatusStyle attrSet _ = setSettingsGtkImStatusStyle attrConstruct _ = constructSettingsGtkImStatusStyle -- VVV Prop "gtk-key-theme-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkKeyThemeName :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkKeyThemeName obj = liftIO $ getObjectPropertyString obj "gtk-key-theme-name" setSettingsGtkKeyThemeName :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkKeyThemeName obj val = liftIO $ setObjectPropertyString obj "gtk-key-theme-name" val constructSettingsGtkKeyThemeName :: T.Text -> IO ([Char], GValue) constructSettingsGtkKeyThemeName val = constructObjectPropertyString "gtk-key-theme-name" val data SettingsGtkKeyThemeNamePropertyInfo instance AttrInfo SettingsGtkKeyThemeNamePropertyInfo where type AttrAllowedOps SettingsGtkKeyThemeNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkKeyThemeNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkKeyThemeNamePropertyInfo = SettingsK type AttrGetType SettingsGtkKeyThemeNamePropertyInfo = T.Text type AttrLabel SettingsGtkKeyThemeNamePropertyInfo = "Settings::gtk-key-theme-name" attrGet _ = getSettingsGtkKeyThemeName attrSet _ = setSettingsGtkKeyThemeName attrConstruct _ = constructSettingsGtkKeyThemeName -- VVV Prop "gtk-keynav-cursor-only" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkKeynavCursorOnly :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkKeynavCursorOnly obj = liftIO $ getObjectPropertyBool obj "gtk-keynav-cursor-only" setSettingsGtkKeynavCursorOnly :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkKeynavCursorOnly obj val = liftIO $ setObjectPropertyBool obj "gtk-keynav-cursor-only" val constructSettingsGtkKeynavCursorOnly :: Bool -> IO ([Char], GValue) constructSettingsGtkKeynavCursorOnly val = constructObjectPropertyBool "gtk-keynav-cursor-only" val data SettingsGtkKeynavCursorOnlyPropertyInfo instance AttrInfo SettingsGtkKeynavCursorOnlyPropertyInfo where type AttrAllowedOps SettingsGtkKeynavCursorOnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkKeynavCursorOnlyPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkKeynavCursorOnlyPropertyInfo = SettingsK type AttrGetType SettingsGtkKeynavCursorOnlyPropertyInfo = Bool type AttrLabel SettingsGtkKeynavCursorOnlyPropertyInfo = "Settings::gtk-keynav-cursor-only" attrGet _ = getSettingsGtkKeynavCursorOnly attrSet _ = setSettingsGtkKeynavCursorOnly attrConstruct _ = constructSettingsGtkKeynavCursorOnly -- VVV Prop "gtk-keynav-wrap-around" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkKeynavWrapAround :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkKeynavWrapAround obj = liftIO $ getObjectPropertyBool obj "gtk-keynav-wrap-around" setSettingsGtkKeynavWrapAround :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkKeynavWrapAround obj val = liftIO $ setObjectPropertyBool obj "gtk-keynav-wrap-around" val constructSettingsGtkKeynavWrapAround :: Bool -> IO ([Char], GValue) constructSettingsGtkKeynavWrapAround val = constructObjectPropertyBool "gtk-keynav-wrap-around" val data SettingsGtkKeynavWrapAroundPropertyInfo instance AttrInfo SettingsGtkKeynavWrapAroundPropertyInfo where type AttrAllowedOps SettingsGtkKeynavWrapAroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkKeynavWrapAroundPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkKeynavWrapAroundPropertyInfo = SettingsK type AttrGetType SettingsGtkKeynavWrapAroundPropertyInfo = Bool type AttrLabel SettingsGtkKeynavWrapAroundPropertyInfo = "Settings::gtk-keynav-wrap-around" attrGet _ = getSettingsGtkKeynavWrapAround attrSet _ = setSettingsGtkKeynavWrapAround attrConstruct _ = constructSettingsGtkKeynavWrapAround -- VVV Prop "gtk-label-select-on-focus" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkLabelSelectOnFocus :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkLabelSelectOnFocus obj = liftIO $ getObjectPropertyBool obj "gtk-label-select-on-focus" setSettingsGtkLabelSelectOnFocus :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkLabelSelectOnFocus obj val = liftIO $ setObjectPropertyBool obj "gtk-label-select-on-focus" val constructSettingsGtkLabelSelectOnFocus :: Bool -> IO ([Char], GValue) constructSettingsGtkLabelSelectOnFocus val = constructObjectPropertyBool "gtk-label-select-on-focus" val data SettingsGtkLabelSelectOnFocusPropertyInfo instance AttrInfo SettingsGtkLabelSelectOnFocusPropertyInfo where type AttrAllowedOps SettingsGtkLabelSelectOnFocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkLabelSelectOnFocusPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkLabelSelectOnFocusPropertyInfo = SettingsK type AttrGetType SettingsGtkLabelSelectOnFocusPropertyInfo = Bool type AttrLabel SettingsGtkLabelSelectOnFocusPropertyInfo = "Settings::gtk-label-select-on-focus" attrGet _ = getSettingsGtkLabelSelectOnFocus attrSet _ = setSettingsGtkLabelSelectOnFocus attrConstruct _ = constructSettingsGtkLabelSelectOnFocus -- VVV Prop "gtk-long-press-time" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkLongPressTime :: (MonadIO m, SettingsK o) => o -> m Word32 getSettingsGtkLongPressTime obj = liftIO $ getObjectPropertyCUInt obj "gtk-long-press-time" setSettingsGtkLongPressTime :: (MonadIO m, SettingsK o) => o -> Word32 -> m () setSettingsGtkLongPressTime obj val = liftIO $ setObjectPropertyCUInt obj "gtk-long-press-time" val constructSettingsGtkLongPressTime :: Word32 -> IO ([Char], GValue) constructSettingsGtkLongPressTime val = constructObjectPropertyCUInt "gtk-long-press-time" val data SettingsGtkLongPressTimePropertyInfo instance AttrInfo SettingsGtkLongPressTimePropertyInfo where type AttrAllowedOps SettingsGtkLongPressTimePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkLongPressTimePropertyInfo = (~) Word32 type AttrBaseTypeConstraint SettingsGtkLongPressTimePropertyInfo = SettingsK type AttrGetType SettingsGtkLongPressTimePropertyInfo = Word32 type AttrLabel SettingsGtkLongPressTimePropertyInfo = "Settings::gtk-long-press-time" attrGet _ = getSettingsGtkLongPressTime attrSet _ = setSettingsGtkLongPressTime attrConstruct _ = constructSettingsGtkLongPressTime -- VVV Prop "gtk-menu-bar-accel" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkMenuBarAccel :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkMenuBarAccel obj = liftIO $ getObjectPropertyString obj "gtk-menu-bar-accel" setSettingsGtkMenuBarAccel :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkMenuBarAccel obj val = liftIO $ setObjectPropertyString obj "gtk-menu-bar-accel" val constructSettingsGtkMenuBarAccel :: T.Text -> IO ([Char], GValue) constructSettingsGtkMenuBarAccel val = constructObjectPropertyString "gtk-menu-bar-accel" val data SettingsGtkMenuBarAccelPropertyInfo instance AttrInfo SettingsGtkMenuBarAccelPropertyInfo where type AttrAllowedOps SettingsGtkMenuBarAccelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkMenuBarAccelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkMenuBarAccelPropertyInfo = SettingsK type AttrGetType SettingsGtkMenuBarAccelPropertyInfo = T.Text type AttrLabel SettingsGtkMenuBarAccelPropertyInfo = "Settings::gtk-menu-bar-accel" attrGet _ = getSettingsGtkMenuBarAccel attrSet _ = setSettingsGtkMenuBarAccel attrConstruct _ = constructSettingsGtkMenuBarAccel -- VVV Prop "gtk-menu-bar-popup-delay" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkMenuBarPopupDelay :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkMenuBarPopupDelay obj = liftIO $ getObjectPropertyCInt obj "gtk-menu-bar-popup-delay" setSettingsGtkMenuBarPopupDelay :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkMenuBarPopupDelay obj val = liftIO $ setObjectPropertyCInt obj "gtk-menu-bar-popup-delay" val constructSettingsGtkMenuBarPopupDelay :: Int32 -> IO ([Char], GValue) constructSettingsGtkMenuBarPopupDelay val = constructObjectPropertyCInt "gtk-menu-bar-popup-delay" val data SettingsGtkMenuBarPopupDelayPropertyInfo instance AttrInfo SettingsGtkMenuBarPopupDelayPropertyInfo where type AttrAllowedOps SettingsGtkMenuBarPopupDelayPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkMenuBarPopupDelayPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkMenuBarPopupDelayPropertyInfo = SettingsK type AttrGetType SettingsGtkMenuBarPopupDelayPropertyInfo = Int32 type AttrLabel SettingsGtkMenuBarPopupDelayPropertyInfo = "Settings::gtk-menu-bar-popup-delay" attrGet _ = getSettingsGtkMenuBarPopupDelay attrSet _ = setSettingsGtkMenuBarPopupDelay attrConstruct _ = constructSettingsGtkMenuBarPopupDelay -- VVV Prop "gtk-menu-images" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkMenuImages :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkMenuImages obj = liftIO $ getObjectPropertyBool obj "gtk-menu-images" setSettingsGtkMenuImages :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkMenuImages obj val = liftIO $ setObjectPropertyBool obj "gtk-menu-images" val constructSettingsGtkMenuImages :: Bool -> IO ([Char], GValue) constructSettingsGtkMenuImages val = constructObjectPropertyBool "gtk-menu-images" val data SettingsGtkMenuImagesPropertyInfo instance AttrInfo SettingsGtkMenuImagesPropertyInfo where type AttrAllowedOps SettingsGtkMenuImagesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkMenuImagesPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkMenuImagesPropertyInfo = SettingsK type AttrGetType SettingsGtkMenuImagesPropertyInfo = Bool type AttrLabel SettingsGtkMenuImagesPropertyInfo = "Settings::gtk-menu-images" attrGet _ = getSettingsGtkMenuImages attrSet _ = setSettingsGtkMenuImages attrConstruct _ = constructSettingsGtkMenuImages -- VVV Prop "gtk-menu-popdown-delay" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkMenuPopdownDelay :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkMenuPopdownDelay obj = liftIO $ getObjectPropertyCInt obj "gtk-menu-popdown-delay" setSettingsGtkMenuPopdownDelay :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkMenuPopdownDelay obj val = liftIO $ setObjectPropertyCInt obj "gtk-menu-popdown-delay" val constructSettingsGtkMenuPopdownDelay :: Int32 -> IO ([Char], GValue) constructSettingsGtkMenuPopdownDelay val = constructObjectPropertyCInt "gtk-menu-popdown-delay" val data SettingsGtkMenuPopdownDelayPropertyInfo instance AttrInfo SettingsGtkMenuPopdownDelayPropertyInfo where type AttrAllowedOps SettingsGtkMenuPopdownDelayPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkMenuPopdownDelayPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkMenuPopdownDelayPropertyInfo = SettingsK type AttrGetType SettingsGtkMenuPopdownDelayPropertyInfo = Int32 type AttrLabel SettingsGtkMenuPopdownDelayPropertyInfo = "Settings::gtk-menu-popdown-delay" attrGet _ = getSettingsGtkMenuPopdownDelay attrSet _ = setSettingsGtkMenuPopdownDelay attrConstruct _ = constructSettingsGtkMenuPopdownDelay -- VVV Prop "gtk-menu-popup-delay" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkMenuPopupDelay :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkMenuPopupDelay obj = liftIO $ getObjectPropertyCInt obj "gtk-menu-popup-delay" setSettingsGtkMenuPopupDelay :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkMenuPopupDelay obj val = liftIO $ setObjectPropertyCInt obj "gtk-menu-popup-delay" val constructSettingsGtkMenuPopupDelay :: Int32 -> IO ([Char], GValue) constructSettingsGtkMenuPopupDelay val = constructObjectPropertyCInt "gtk-menu-popup-delay" val data SettingsGtkMenuPopupDelayPropertyInfo instance AttrInfo SettingsGtkMenuPopupDelayPropertyInfo where type AttrAllowedOps SettingsGtkMenuPopupDelayPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkMenuPopupDelayPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkMenuPopupDelayPropertyInfo = SettingsK type AttrGetType SettingsGtkMenuPopupDelayPropertyInfo = Int32 type AttrLabel SettingsGtkMenuPopupDelayPropertyInfo = "Settings::gtk-menu-popup-delay" attrGet _ = getSettingsGtkMenuPopupDelay attrSet _ = setSettingsGtkMenuPopupDelay attrConstruct _ = constructSettingsGtkMenuPopupDelay -- VVV Prop "gtk-modules" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkModules :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkModules obj = liftIO $ getObjectPropertyString obj "gtk-modules" setSettingsGtkModules :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkModules obj val = liftIO $ setObjectPropertyString obj "gtk-modules" val constructSettingsGtkModules :: T.Text -> IO ([Char], GValue) constructSettingsGtkModules val = constructObjectPropertyString "gtk-modules" val data SettingsGtkModulesPropertyInfo instance AttrInfo SettingsGtkModulesPropertyInfo where type AttrAllowedOps SettingsGtkModulesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkModulesPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkModulesPropertyInfo = SettingsK type AttrGetType SettingsGtkModulesPropertyInfo = T.Text type AttrLabel SettingsGtkModulesPropertyInfo = "Settings::gtk-modules" attrGet _ = getSettingsGtkModules attrSet _ = setSettingsGtkModules attrConstruct _ = constructSettingsGtkModules -- VVV Prop "gtk-primary-button-warps-slider" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkPrimaryButtonWarpsSlider :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkPrimaryButtonWarpsSlider obj = liftIO $ getObjectPropertyBool obj "gtk-primary-button-warps-slider" setSettingsGtkPrimaryButtonWarpsSlider :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkPrimaryButtonWarpsSlider obj val = liftIO $ setObjectPropertyBool obj "gtk-primary-button-warps-slider" val constructSettingsGtkPrimaryButtonWarpsSlider :: Bool -> IO ([Char], GValue) constructSettingsGtkPrimaryButtonWarpsSlider val = constructObjectPropertyBool "gtk-primary-button-warps-slider" val data SettingsGtkPrimaryButtonWarpsSliderPropertyInfo instance AttrInfo SettingsGtkPrimaryButtonWarpsSliderPropertyInfo where type AttrAllowedOps SettingsGtkPrimaryButtonWarpsSliderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkPrimaryButtonWarpsSliderPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkPrimaryButtonWarpsSliderPropertyInfo = SettingsK type AttrGetType SettingsGtkPrimaryButtonWarpsSliderPropertyInfo = Bool type AttrLabel SettingsGtkPrimaryButtonWarpsSliderPropertyInfo = "Settings::gtk-primary-button-warps-slider" attrGet _ = getSettingsGtkPrimaryButtonWarpsSlider attrSet _ = setSettingsGtkPrimaryButtonWarpsSlider attrConstruct _ = constructSettingsGtkPrimaryButtonWarpsSlider -- VVV Prop "gtk-print-backends" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkPrintBackends :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkPrintBackends obj = liftIO $ getObjectPropertyString obj "gtk-print-backends" setSettingsGtkPrintBackends :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkPrintBackends obj val = liftIO $ setObjectPropertyString obj "gtk-print-backends" val constructSettingsGtkPrintBackends :: T.Text -> IO ([Char], GValue) constructSettingsGtkPrintBackends val = constructObjectPropertyString "gtk-print-backends" val data SettingsGtkPrintBackendsPropertyInfo instance AttrInfo SettingsGtkPrintBackendsPropertyInfo where type AttrAllowedOps SettingsGtkPrintBackendsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkPrintBackendsPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkPrintBackendsPropertyInfo = SettingsK type AttrGetType SettingsGtkPrintBackendsPropertyInfo = T.Text type AttrLabel SettingsGtkPrintBackendsPropertyInfo = "Settings::gtk-print-backends" attrGet _ = getSettingsGtkPrintBackends attrSet _ = setSettingsGtkPrintBackends attrConstruct _ = constructSettingsGtkPrintBackends -- VVV Prop "gtk-print-preview-command" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkPrintPreviewCommand :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkPrintPreviewCommand obj = liftIO $ getObjectPropertyString obj "gtk-print-preview-command" setSettingsGtkPrintPreviewCommand :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkPrintPreviewCommand obj val = liftIO $ setObjectPropertyString obj "gtk-print-preview-command" val constructSettingsGtkPrintPreviewCommand :: T.Text -> IO ([Char], GValue) constructSettingsGtkPrintPreviewCommand val = constructObjectPropertyString "gtk-print-preview-command" val data SettingsGtkPrintPreviewCommandPropertyInfo instance AttrInfo SettingsGtkPrintPreviewCommandPropertyInfo where type AttrAllowedOps SettingsGtkPrintPreviewCommandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkPrintPreviewCommandPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkPrintPreviewCommandPropertyInfo = SettingsK type AttrGetType SettingsGtkPrintPreviewCommandPropertyInfo = T.Text type AttrLabel SettingsGtkPrintPreviewCommandPropertyInfo = "Settings::gtk-print-preview-command" attrGet _ = getSettingsGtkPrintPreviewCommand attrSet _ = setSettingsGtkPrintPreviewCommand attrConstruct _ = constructSettingsGtkPrintPreviewCommand -- VVV Prop "gtk-recent-files-enabled" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkRecentFilesEnabled :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkRecentFilesEnabled obj = liftIO $ getObjectPropertyBool obj "gtk-recent-files-enabled" setSettingsGtkRecentFilesEnabled :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkRecentFilesEnabled obj val = liftIO $ setObjectPropertyBool obj "gtk-recent-files-enabled" val constructSettingsGtkRecentFilesEnabled :: Bool -> IO ([Char], GValue) constructSettingsGtkRecentFilesEnabled val = constructObjectPropertyBool "gtk-recent-files-enabled" val data SettingsGtkRecentFilesEnabledPropertyInfo instance AttrInfo SettingsGtkRecentFilesEnabledPropertyInfo where type AttrAllowedOps SettingsGtkRecentFilesEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkRecentFilesEnabledPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkRecentFilesEnabledPropertyInfo = SettingsK type AttrGetType SettingsGtkRecentFilesEnabledPropertyInfo = Bool type AttrLabel SettingsGtkRecentFilesEnabledPropertyInfo = "Settings::gtk-recent-files-enabled" attrGet _ = getSettingsGtkRecentFilesEnabled attrSet _ = setSettingsGtkRecentFilesEnabled attrConstruct _ = constructSettingsGtkRecentFilesEnabled -- VVV Prop "gtk-recent-files-limit" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkRecentFilesLimit :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkRecentFilesLimit obj = liftIO $ getObjectPropertyCInt obj "gtk-recent-files-limit" setSettingsGtkRecentFilesLimit :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkRecentFilesLimit obj val = liftIO $ setObjectPropertyCInt obj "gtk-recent-files-limit" val constructSettingsGtkRecentFilesLimit :: Int32 -> IO ([Char], GValue) constructSettingsGtkRecentFilesLimit val = constructObjectPropertyCInt "gtk-recent-files-limit" val data SettingsGtkRecentFilesLimitPropertyInfo instance AttrInfo SettingsGtkRecentFilesLimitPropertyInfo where type AttrAllowedOps SettingsGtkRecentFilesLimitPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkRecentFilesLimitPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkRecentFilesLimitPropertyInfo = SettingsK type AttrGetType SettingsGtkRecentFilesLimitPropertyInfo = Int32 type AttrLabel SettingsGtkRecentFilesLimitPropertyInfo = "Settings::gtk-recent-files-limit" attrGet _ = getSettingsGtkRecentFilesLimit attrSet _ = setSettingsGtkRecentFilesLimit attrConstruct _ = constructSettingsGtkRecentFilesLimit -- VVV Prop "gtk-recent-files-max-age" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkRecentFilesMaxAge :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkRecentFilesMaxAge obj = liftIO $ getObjectPropertyCInt obj "gtk-recent-files-max-age" setSettingsGtkRecentFilesMaxAge :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkRecentFilesMaxAge obj val = liftIO $ setObjectPropertyCInt obj "gtk-recent-files-max-age" val constructSettingsGtkRecentFilesMaxAge :: Int32 -> IO ([Char], GValue) constructSettingsGtkRecentFilesMaxAge val = constructObjectPropertyCInt "gtk-recent-files-max-age" val data SettingsGtkRecentFilesMaxAgePropertyInfo instance AttrInfo SettingsGtkRecentFilesMaxAgePropertyInfo where type AttrAllowedOps SettingsGtkRecentFilesMaxAgePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkRecentFilesMaxAgePropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkRecentFilesMaxAgePropertyInfo = SettingsK type AttrGetType SettingsGtkRecentFilesMaxAgePropertyInfo = Int32 type AttrLabel SettingsGtkRecentFilesMaxAgePropertyInfo = "Settings::gtk-recent-files-max-age" attrGet _ = getSettingsGtkRecentFilesMaxAge attrSet _ = setSettingsGtkRecentFilesMaxAge attrConstruct _ = constructSettingsGtkRecentFilesMaxAge -- VVV Prop "gtk-scrolled-window-placement" -- Type: TInterface "Gtk" "CornerType" -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkScrolledWindowPlacement :: (MonadIO m, SettingsK o) => o -> m CornerType getSettingsGtkScrolledWindowPlacement obj = liftIO $ getObjectPropertyEnum obj "gtk-scrolled-window-placement" setSettingsGtkScrolledWindowPlacement :: (MonadIO m, SettingsK o) => o -> CornerType -> m () setSettingsGtkScrolledWindowPlacement obj val = liftIO $ setObjectPropertyEnum obj "gtk-scrolled-window-placement" val constructSettingsGtkScrolledWindowPlacement :: CornerType -> IO ([Char], GValue) constructSettingsGtkScrolledWindowPlacement val = constructObjectPropertyEnum "gtk-scrolled-window-placement" val data SettingsGtkScrolledWindowPlacementPropertyInfo instance AttrInfo SettingsGtkScrolledWindowPlacementPropertyInfo where type AttrAllowedOps SettingsGtkScrolledWindowPlacementPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkScrolledWindowPlacementPropertyInfo = (~) CornerType type AttrBaseTypeConstraint SettingsGtkScrolledWindowPlacementPropertyInfo = SettingsK type AttrGetType SettingsGtkScrolledWindowPlacementPropertyInfo = CornerType type AttrLabel SettingsGtkScrolledWindowPlacementPropertyInfo = "Settings::gtk-scrolled-window-placement" attrGet _ = getSettingsGtkScrolledWindowPlacement attrSet _ = setSettingsGtkScrolledWindowPlacement attrConstruct _ = constructSettingsGtkScrolledWindowPlacement -- VVV Prop "gtk-shell-shows-app-menu" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkShellShowsAppMenu :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkShellShowsAppMenu obj = liftIO $ getObjectPropertyBool obj "gtk-shell-shows-app-menu" setSettingsGtkShellShowsAppMenu :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkShellShowsAppMenu obj val = liftIO $ setObjectPropertyBool obj "gtk-shell-shows-app-menu" val constructSettingsGtkShellShowsAppMenu :: Bool -> IO ([Char], GValue) constructSettingsGtkShellShowsAppMenu val = constructObjectPropertyBool "gtk-shell-shows-app-menu" val data SettingsGtkShellShowsAppMenuPropertyInfo instance AttrInfo SettingsGtkShellShowsAppMenuPropertyInfo where type AttrAllowedOps SettingsGtkShellShowsAppMenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkShellShowsAppMenuPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkShellShowsAppMenuPropertyInfo = SettingsK type AttrGetType SettingsGtkShellShowsAppMenuPropertyInfo = Bool type AttrLabel SettingsGtkShellShowsAppMenuPropertyInfo = "Settings::gtk-shell-shows-app-menu" attrGet _ = getSettingsGtkShellShowsAppMenu attrSet _ = setSettingsGtkShellShowsAppMenu attrConstruct _ = constructSettingsGtkShellShowsAppMenu -- VVV Prop "gtk-shell-shows-desktop" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkShellShowsDesktop :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkShellShowsDesktop obj = liftIO $ getObjectPropertyBool obj "gtk-shell-shows-desktop" setSettingsGtkShellShowsDesktop :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkShellShowsDesktop obj val = liftIO $ setObjectPropertyBool obj "gtk-shell-shows-desktop" val constructSettingsGtkShellShowsDesktop :: Bool -> IO ([Char], GValue) constructSettingsGtkShellShowsDesktop val = constructObjectPropertyBool "gtk-shell-shows-desktop" val data SettingsGtkShellShowsDesktopPropertyInfo instance AttrInfo SettingsGtkShellShowsDesktopPropertyInfo where type AttrAllowedOps SettingsGtkShellShowsDesktopPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkShellShowsDesktopPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkShellShowsDesktopPropertyInfo = SettingsK type AttrGetType SettingsGtkShellShowsDesktopPropertyInfo = Bool type AttrLabel SettingsGtkShellShowsDesktopPropertyInfo = "Settings::gtk-shell-shows-desktop" attrGet _ = getSettingsGtkShellShowsDesktop attrSet _ = setSettingsGtkShellShowsDesktop attrConstruct _ = constructSettingsGtkShellShowsDesktop -- VVV Prop "gtk-shell-shows-menubar" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkShellShowsMenubar :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkShellShowsMenubar obj = liftIO $ getObjectPropertyBool obj "gtk-shell-shows-menubar" setSettingsGtkShellShowsMenubar :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkShellShowsMenubar obj val = liftIO $ setObjectPropertyBool obj "gtk-shell-shows-menubar" val constructSettingsGtkShellShowsMenubar :: Bool -> IO ([Char], GValue) constructSettingsGtkShellShowsMenubar val = constructObjectPropertyBool "gtk-shell-shows-menubar" val data SettingsGtkShellShowsMenubarPropertyInfo instance AttrInfo SettingsGtkShellShowsMenubarPropertyInfo where type AttrAllowedOps SettingsGtkShellShowsMenubarPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkShellShowsMenubarPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkShellShowsMenubarPropertyInfo = SettingsK type AttrGetType SettingsGtkShellShowsMenubarPropertyInfo = Bool type AttrLabel SettingsGtkShellShowsMenubarPropertyInfo = "Settings::gtk-shell-shows-menubar" attrGet _ = getSettingsGtkShellShowsMenubar attrSet _ = setSettingsGtkShellShowsMenubar attrConstruct _ = constructSettingsGtkShellShowsMenubar -- VVV Prop "gtk-show-input-method-menu" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkShowInputMethodMenu :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkShowInputMethodMenu obj = liftIO $ getObjectPropertyBool obj "gtk-show-input-method-menu" setSettingsGtkShowInputMethodMenu :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkShowInputMethodMenu obj val = liftIO $ setObjectPropertyBool obj "gtk-show-input-method-menu" val constructSettingsGtkShowInputMethodMenu :: Bool -> IO ([Char], GValue) constructSettingsGtkShowInputMethodMenu val = constructObjectPropertyBool "gtk-show-input-method-menu" val data SettingsGtkShowInputMethodMenuPropertyInfo instance AttrInfo SettingsGtkShowInputMethodMenuPropertyInfo where type AttrAllowedOps SettingsGtkShowInputMethodMenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkShowInputMethodMenuPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkShowInputMethodMenuPropertyInfo = SettingsK type AttrGetType SettingsGtkShowInputMethodMenuPropertyInfo = Bool type AttrLabel SettingsGtkShowInputMethodMenuPropertyInfo = "Settings::gtk-show-input-method-menu" attrGet _ = getSettingsGtkShowInputMethodMenu attrSet _ = setSettingsGtkShowInputMethodMenu attrConstruct _ = constructSettingsGtkShowInputMethodMenu -- VVV Prop "gtk-show-unicode-menu" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkShowUnicodeMenu :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkShowUnicodeMenu obj = liftIO $ getObjectPropertyBool obj "gtk-show-unicode-menu" setSettingsGtkShowUnicodeMenu :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkShowUnicodeMenu obj val = liftIO $ setObjectPropertyBool obj "gtk-show-unicode-menu" val constructSettingsGtkShowUnicodeMenu :: Bool -> IO ([Char], GValue) constructSettingsGtkShowUnicodeMenu val = constructObjectPropertyBool "gtk-show-unicode-menu" val data SettingsGtkShowUnicodeMenuPropertyInfo instance AttrInfo SettingsGtkShowUnicodeMenuPropertyInfo where type AttrAllowedOps SettingsGtkShowUnicodeMenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkShowUnicodeMenuPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkShowUnicodeMenuPropertyInfo = SettingsK type AttrGetType SettingsGtkShowUnicodeMenuPropertyInfo = Bool type AttrLabel SettingsGtkShowUnicodeMenuPropertyInfo = "Settings::gtk-show-unicode-menu" attrGet _ = getSettingsGtkShowUnicodeMenu attrSet _ = setSettingsGtkShowUnicodeMenu attrConstruct _ = constructSettingsGtkShowUnicodeMenu -- VVV Prop "gtk-sound-theme-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkSoundThemeName :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkSoundThemeName obj = liftIO $ getObjectPropertyString obj "gtk-sound-theme-name" setSettingsGtkSoundThemeName :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkSoundThemeName obj val = liftIO $ setObjectPropertyString obj "gtk-sound-theme-name" val constructSettingsGtkSoundThemeName :: T.Text -> IO ([Char], GValue) constructSettingsGtkSoundThemeName val = constructObjectPropertyString "gtk-sound-theme-name" val data SettingsGtkSoundThemeNamePropertyInfo instance AttrInfo SettingsGtkSoundThemeNamePropertyInfo where type AttrAllowedOps SettingsGtkSoundThemeNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkSoundThemeNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkSoundThemeNamePropertyInfo = SettingsK type AttrGetType SettingsGtkSoundThemeNamePropertyInfo = T.Text type AttrLabel SettingsGtkSoundThemeNamePropertyInfo = "Settings::gtk-sound-theme-name" attrGet _ = getSettingsGtkSoundThemeName attrSet _ = setSettingsGtkSoundThemeName attrConstruct _ = constructSettingsGtkSoundThemeName -- VVV Prop "gtk-split-cursor" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkSplitCursor :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkSplitCursor obj = liftIO $ getObjectPropertyBool obj "gtk-split-cursor" setSettingsGtkSplitCursor :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkSplitCursor obj val = liftIO $ setObjectPropertyBool obj "gtk-split-cursor" val constructSettingsGtkSplitCursor :: Bool -> IO ([Char], GValue) constructSettingsGtkSplitCursor val = constructObjectPropertyBool "gtk-split-cursor" val data SettingsGtkSplitCursorPropertyInfo instance AttrInfo SettingsGtkSplitCursorPropertyInfo where type AttrAllowedOps SettingsGtkSplitCursorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkSplitCursorPropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkSplitCursorPropertyInfo = SettingsK type AttrGetType SettingsGtkSplitCursorPropertyInfo = Bool type AttrLabel SettingsGtkSplitCursorPropertyInfo = "Settings::gtk-split-cursor" attrGet _ = getSettingsGtkSplitCursor attrSet _ = setSettingsGtkSplitCursor attrConstruct _ = constructSettingsGtkSplitCursor -- VVV Prop "gtk-theme-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkThemeName :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkThemeName obj = liftIO $ getObjectPropertyString obj "gtk-theme-name" setSettingsGtkThemeName :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkThemeName obj val = liftIO $ setObjectPropertyString obj "gtk-theme-name" val constructSettingsGtkThemeName :: T.Text -> IO ([Char], GValue) constructSettingsGtkThemeName val = constructObjectPropertyString "gtk-theme-name" val data SettingsGtkThemeNamePropertyInfo instance AttrInfo SettingsGtkThemeNamePropertyInfo where type AttrAllowedOps SettingsGtkThemeNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkThemeNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkThemeNamePropertyInfo = SettingsK type AttrGetType SettingsGtkThemeNamePropertyInfo = T.Text type AttrLabel SettingsGtkThemeNamePropertyInfo = "Settings::gtk-theme-name" attrGet _ = getSettingsGtkThemeName attrSet _ = setSettingsGtkThemeName attrConstruct _ = constructSettingsGtkThemeName -- VVV Prop "gtk-timeout-expand" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkTimeoutExpand :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkTimeoutExpand obj = liftIO $ getObjectPropertyCInt obj "gtk-timeout-expand" setSettingsGtkTimeoutExpand :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkTimeoutExpand obj val = liftIO $ setObjectPropertyCInt obj "gtk-timeout-expand" val constructSettingsGtkTimeoutExpand :: Int32 -> IO ([Char], GValue) constructSettingsGtkTimeoutExpand val = constructObjectPropertyCInt "gtk-timeout-expand" val data SettingsGtkTimeoutExpandPropertyInfo instance AttrInfo SettingsGtkTimeoutExpandPropertyInfo where type AttrAllowedOps SettingsGtkTimeoutExpandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkTimeoutExpandPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkTimeoutExpandPropertyInfo = SettingsK type AttrGetType SettingsGtkTimeoutExpandPropertyInfo = Int32 type AttrLabel SettingsGtkTimeoutExpandPropertyInfo = "Settings::gtk-timeout-expand" attrGet _ = getSettingsGtkTimeoutExpand attrSet _ = setSettingsGtkTimeoutExpand attrConstruct _ = constructSettingsGtkTimeoutExpand -- VVV Prop "gtk-timeout-initial" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkTimeoutInitial :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkTimeoutInitial obj = liftIO $ getObjectPropertyCInt obj "gtk-timeout-initial" setSettingsGtkTimeoutInitial :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkTimeoutInitial obj val = liftIO $ setObjectPropertyCInt obj "gtk-timeout-initial" val constructSettingsGtkTimeoutInitial :: Int32 -> IO ([Char], GValue) constructSettingsGtkTimeoutInitial val = constructObjectPropertyCInt "gtk-timeout-initial" val data SettingsGtkTimeoutInitialPropertyInfo instance AttrInfo SettingsGtkTimeoutInitialPropertyInfo where type AttrAllowedOps SettingsGtkTimeoutInitialPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkTimeoutInitialPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkTimeoutInitialPropertyInfo = SettingsK type AttrGetType SettingsGtkTimeoutInitialPropertyInfo = Int32 type AttrLabel SettingsGtkTimeoutInitialPropertyInfo = "Settings::gtk-timeout-initial" attrGet _ = getSettingsGtkTimeoutInitial attrSet _ = setSettingsGtkTimeoutInitial attrConstruct _ = constructSettingsGtkTimeoutInitial -- VVV Prop "gtk-timeout-repeat" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkTimeoutRepeat :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkTimeoutRepeat obj = liftIO $ getObjectPropertyCInt obj "gtk-timeout-repeat" setSettingsGtkTimeoutRepeat :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkTimeoutRepeat obj val = liftIO $ setObjectPropertyCInt obj "gtk-timeout-repeat" val constructSettingsGtkTimeoutRepeat :: Int32 -> IO ([Char], GValue) constructSettingsGtkTimeoutRepeat val = constructObjectPropertyCInt "gtk-timeout-repeat" val data SettingsGtkTimeoutRepeatPropertyInfo instance AttrInfo SettingsGtkTimeoutRepeatPropertyInfo where type AttrAllowedOps SettingsGtkTimeoutRepeatPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkTimeoutRepeatPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkTimeoutRepeatPropertyInfo = SettingsK type AttrGetType SettingsGtkTimeoutRepeatPropertyInfo = Int32 type AttrLabel SettingsGtkTimeoutRepeatPropertyInfo = "Settings::gtk-timeout-repeat" attrGet _ = getSettingsGtkTimeoutRepeat attrSet _ = setSettingsGtkTimeoutRepeat attrConstruct _ = constructSettingsGtkTimeoutRepeat -- VVV Prop "gtk-titlebar-double-click" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkTitlebarDoubleClick :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkTitlebarDoubleClick obj = liftIO $ getObjectPropertyString obj "gtk-titlebar-double-click" setSettingsGtkTitlebarDoubleClick :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkTitlebarDoubleClick obj val = liftIO $ setObjectPropertyString obj "gtk-titlebar-double-click" val constructSettingsGtkTitlebarDoubleClick :: T.Text -> IO ([Char], GValue) constructSettingsGtkTitlebarDoubleClick val = constructObjectPropertyString "gtk-titlebar-double-click" val data SettingsGtkTitlebarDoubleClickPropertyInfo instance AttrInfo SettingsGtkTitlebarDoubleClickPropertyInfo where type AttrAllowedOps SettingsGtkTitlebarDoubleClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkTitlebarDoubleClickPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkTitlebarDoubleClickPropertyInfo = SettingsK type AttrGetType SettingsGtkTitlebarDoubleClickPropertyInfo = T.Text type AttrLabel SettingsGtkTitlebarDoubleClickPropertyInfo = "Settings::gtk-titlebar-double-click" attrGet _ = getSettingsGtkTitlebarDoubleClick attrSet _ = setSettingsGtkTitlebarDoubleClick attrConstruct _ = constructSettingsGtkTitlebarDoubleClick -- VVV Prop "gtk-titlebar-middle-click" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkTitlebarMiddleClick :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkTitlebarMiddleClick obj = liftIO $ getObjectPropertyString obj "gtk-titlebar-middle-click" setSettingsGtkTitlebarMiddleClick :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkTitlebarMiddleClick obj val = liftIO $ setObjectPropertyString obj "gtk-titlebar-middle-click" val constructSettingsGtkTitlebarMiddleClick :: T.Text -> IO ([Char], GValue) constructSettingsGtkTitlebarMiddleClick val = constructObjectPropertyString "gtk-titlebar-middle-click" val data SettingsGtkTitlebarMiddleClickPropertyInfo instance AttrInfo SettingsGtkTitlebarMiddleClickPropertyInfo where type AttrAllowedOps SettingsGtkTitlebarMiddleClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkTitlebarMiddleClickPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkTitlebarMiddleClickPropertyInfo = SettingsK type AttrGetType SettingsGtkTitlebarMiddleClickPropertyInfo = T.Text type AttrLabel SettingsGtkTitlebarMiddleClickPropertyInfo = "Settings::gtk-titlebar-middle-click" attrGet _ = getSettingsGtkTitlebarMiddleClick attrSet _ = setSettingsGtkTitlebarMiddleClick attrConstruct _ = constructSettingsGtkTitlebarMiddleClick -- VVV Prop "gtk-titlebar-right-click" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkTitlebarRightClick :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkTitlebarRightClick obj = liftIO $ getObjectPropertyString obj "gtk-titlebar-right-click" setSettingsGtkTitlebarRightClick :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkTitlebarRightClick obj val = liftIO $ setObjectPropertyString obj "gtk-titlebar-right-click" val constructSettingsGtkTitlebarRightClick :: T.Text -> IO ([Char], GValue) constructSettingsGtkTitlebarRightClick val = constructObjectPropertyString "gtk-titlebar-right-click" val data SettingsGtkTitlebarRightClickPropertyInfo instance AttrInfo SettingsGtkTitlebarRightClickPropertyInfo where type AttrAllowedOps SettingsGtkTitlebarRightClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkTitlebarRightClickPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkTitlebarRightClickPropertyInfo = SettingsK type AttrGetType SettingsGtkTitlebarRightClickPropertyInfo = T.Text type AttrLabel SettingsGtkTitlebarRightClickPropertyInfo = "Settings::gtk-titlebar-right-click" attrGet _ = getSettingsGtkTitlebarRightClick attrSet _ = setSettingsGtkTitlebarRightClick attrConstruct _ = constructSettingsGtkTitlebarRightClick -- VVV Prop "gtk-toolbar-icon-size" -- Type: TInterface "Gtk" "IconSize" -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkToolbarIconSize :: (MonadIO m, SettingsK o) => o -> m IconSize getSettingsGtkToolbarIconSize obj = liftIO $ getObjectPropertyEnum obj "gtk-toolbar-icon-size" setSettingsGtkToolbarIconSize :: (MonadIO m, SettingsK o) => o -> IconSize -> m () setSettingsGtkToolbarIconSize obj val = liftIO $ setObjectPropertyEnum obj "gtk-toolbar-icon-size" val constructSettingsGtkToolbarIconSize :: IconSize -> IO ([Char], GValue) constructSettingsGtkToolbarIconSize val = constructObjectPropertyEnum "gtk-toolbar-icon-size" val data SettingsGtkToolbarIconSizePropertyInfo instance AttrInfo SettingsGtkToolbarIconSizePropertyInfo where type AttrAllowedOps SettingsGtkToolbarIconSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkToolbarIconSizePropertyInfo = (~) IconSize type AttrBaseTypeConstraint SettingsGtkToolbarIconSizePropertyInfo = SettingsK type AttrGetType SettingsGtkToolbarIconSizePropertyInfo = IconSize type AttrLabel SettingsGtkToolbarIconSizePropertyInfo = "Settings::gtk-toolbar-icon-size" attrGet _ = getSettingsGtkToolbarIconSize attrSet _ = setSettingsGtkToolbarIconSize attrConstruct _ = constructSettingsGtkToolbarIconSize -- VVV Prop "gtk-toolbar-style" -- Type: TInterface "Gtk" "ToolbarStyle" -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkToolbarStyle :: (MonadIO m, SettingsK o) => o -> m ToolbarStyle getSettingsGtkToolbarStyle obj = liftIO $ getObjectPropertyEnum obj "gtk-toolbar-style" setSettingsGtkToolbarStyle :: (MonadIO m, SettingsK o) => o -> ToolbarStyle -> m () setSettingsGtkToolbarStyle obj val = liftIO $ setObjectPropertyEnum obj "gtk-toolbar-style" val constructSettingsGtkToolbarStyle :: ToolbarStyle -> IO ([Char], GValue) constructSettingsGtkToolbarStyle val = constructObjectPropertyEnum "gtk-toolbar-style" val data SettingsGtkToolbarStylePropertyInfo instance AttrInfo SettingsGtkToolbarStylePropertyInfo where type AttrAllowedOps SettingsGtkToolbarStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkToolbarStylePropertyInfo = (~) ToolbarStyle type AttrBaseTypeConstraint SettingsGtkToolbarStylePropertyInfo = SettingsK type AttrGetType SettingsGtkToolbarStylePropertyInfo = ToolbarStyle type AttrLabel SettingsGtkToolbarStylePropertyInfo = "Settings::gtk-toolbar-style" attrGet _ = getSettingsGtkToolbarStyle attrSet _ = setSettingsGtkToolbarStyle attrConstruct _ = constructSettingsGtkToolbarStyle -- VVV Prop "gtk-tooltip-browse-mode-timeout" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkTooltipBrowseModeTimeout :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkTooltipBrowseModeTimeout obj = liftIO $ getObjectPropertyCInt obj "gtk-tooltip-browse-mode-timeout" setSettingsGtkTooltipBrowseModeTimeout :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkTooltipBrowseModeTimeout obj val = liftIO $ setObjectPropertyCInt obj "gtk-tooltip-browse-mode-timeout" val constructSettingsGtkTooltipBrowseModeTimeout :: Int32 -> IO ([Char], GValue) constructSettingsGtkTooltipBrowseModeTimeout val = constructObjectPropertyCInt "gtk-tooltip-browse-mode-timeout" val data SettingsGtkTooltipBrowseModeTimeoutPropertyInfo instance AttrInfo SettingsGtkTooltipBrowseModeTimeoutPropertyInfo where type AttrAllowedOps SettingsGtkTooltipBrowseModeTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkTooltipBrowseModeTimeoutPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkTooltipBrowseModeTimeoutPropertyInfo = SettingsK type AttrGetType SettingsGtkTooltipBrowseModeTimeoutPropertyInfo = Int32 type AttrLabel SettingsGtkTooltipBrowseModeTimeoutPropertyInfo = "Settings::gtk-tooltip-browse-mode-timeout" attrGet _ = getSettingsGtkTooltipBrowseModeTimeout attrSet _ = setSettingsGtkTooltipBrowseModeTimeout attrConstruct _ = constructSettingsGtkTooltipBrowseModeTimeout -- VVV Prop "gtk-tooltip-browse-timeout" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkTooltipBrowseTimeout :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkTooltipBrowseTimeout obj = liftIO $ getObjectPropertyCInt obj "gtk-tooltip-browse-timeout" setSettingsGtkTooltipBrowseTimeout :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkTooltipBrowseTimeout obj val = liftIO $ setObjectPropertyCInt obj "gtk-tooltip-browse-timeout" val constructSettingsGtkTooltipBrowseTimeout :: Int32 -> IO ([Char], GValue) constructSettingsGtkTooltipBrowseTimeout val = constructObjectPropertyCInt "gtk-tooltip-browse-timeout" val data SettingsGtkTooltipBrowseTimeoutPropertyInfo instance AttrInfo SettingsGtkTooltipBrowseTimeoutPropertyInfo where type AttrAllowedOps SettingsGtkTooltipBrowseTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkTooltipBrowseTimeoutPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkTooltipBrowseTimeoutPropertyInfo = SettingsK type AttrGetType SettingsGtkTooltipBrowseTimeoutPropertyInfo = Int32 type AttrLabel SettingsGtkTooltipBrowseTimeoutPropertyInfo = "Settings::gtk-tooltip-browse-timeout" attrGet _ = getSettingsGtkTooltipBrowseTimeout attrSet _ = setSettingsGtkTooltipBrowseTimeout attrConstruct _ = constructSettingsGtkTooltipBrowseTimeout -- VVV Prop "gtk-tooltip-timeout" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkTooltipTimeout :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkTooltipTimeout obj = liftIO $ getObjectPropertyCInt obj "gtk-tooltip-timeout" setSettingsGtkTooltipTimeout :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkTooltipTimeout obj val = liftIO $ setObjectPropertyCInt obj "gtk-tooltip-timeout" val constructSettingsGtkTooltipTimeout :: Int32 -> IO ([Char], GValue) constructSettingsGtkTooltipTimeout val = constructObjectPropertyCInt "gtk-tooltip-timeout" val data SettingsGtkTooltipTimeoutPropertyInfo instance AttrInfo SettingsGtkTooltipTimeoutPropertyInfo where type AttrAllowedOps SettingsGtkTooltipTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkTooltipTimeoutPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkTooltipTimeoutPropertyInfo = SettingsK type AttrGetType SettingsGtkTooltipTimeoutPropertyInfo = Int32 type AttrLabel SettingsGtkTooltipTimeoutPropertyInfo = "Settings::gtk-tooltip-timeout" attrGet _ = getSettingsGtkTooltipTimeout attrSet _ = setSettingsGtkTooltipTimeout attrConstruct _ = constructSettingsGtkTooltipTimeout -- VVV Prop "gtk-touchscreen-mode" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkTouchscreenMode :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsGtkTouchscreenMode obj = liftIO $ getObjectPropertyBool obj "gtk-touchscreen-mode" setSettingsGtkTouchscreenMode :: (MonadIO m, SettingsK o) => o -> Bool -> m () setSettingsGtkTouchscreenMode obj val = liftIO $ setObjectPropertyBool obj "gtk-touchscreen-mode" val constructSettingsGtkTouchscreenMode :: Bool -> IO ([Char], GValue) constructSettingsGtkTouchscreenMode val = constructObjectPropertyBool "gtk-touchscreen-mode" val data SettingsGtkTouchscreenModePropertyInfo instance AttrInfo SettingsGtkTouchscreenModePropertyInfo where type AttrAllowedOps SettingsGtkTouchscreenModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkTouchscreenModePropertyInfo = (~) Bool type AttrBaseTypeConstraint SettingsGtkTouchscreenModePropertyInfo = SettingsK type AttrGetType SettingsGtkTouchscreenModePropertyInfo = Bool type AttrLabel SettingsGtkTouchscreenModePropertyInfo = "Settings::gtk-touchscreen-mode" attrGet _ = getSettingsGtkTouchscreenMode attrSet _ = setSettingsGtkTouchscreenMode attrConstruct _ = constructSettingsGtkTouchscreenMode -- VVV Prop "gtk-visible-focus" -- Type: TInterface "Gtk" "PolicyType" -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkVisibleFocus :: (MonadIO m, SettingsK o) => o -> m PolicyType getSettingsGtkVisibleFocus obj = liftIO $ getObjectPropertyEnum obj "gtk-visible-focus" setSettingsGtkVisibleFocus :: (MonadIO m, SettingsK o) => o -> PolicyType -> m () setSettingsGtkVisibleFocus obj val = liftIO $ setObjectPropertyEnum obj "gtk-visible-focus" val constructSettingsGtkVisibleFocus :: PolicyType -> IO ([Char], GValue) constructSettingsGtkVisibleFocus val = constructObjectPropertyEnum "gtk-visible-focus" val data SettingsGtkVisibleFocusPropertyInfo instance AttrInfo SettingsGtkVisibleFocusPropertyInfo where type AttrAllowedOps SettingsGtkVisibleFocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkVisibleFocusPropertyInfo = (~) PolicyType type AttrBaseTypeConstraint SettingsGtkVisibleFocusPropertyInfo = SettingsK type AttrGetType SettingsGtkVisibleFocusPropertyInfo = PolicyType type AttrLabel SettingsGtkVisibleFocusPropertyInfo = "Settings::gtk-visible-focus" attrGet _ = getSettingsGtkVisibleFocus attrSet _ = setSettingsGtkVisibleFocus attrConstruct _ = constructSettingsGtkVisibleFocus -- VVV Prop "gtk-xft-antialias" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkXftAntialias :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkXftAntialias obj = liftIO $ getObjectPropertyCInt obj "gtk-xft-antialias" setSettingsGtkXftAntialias :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkXftAntialias obj val = liftIO $ setObjectPropertyCInt obj "gtk-xft-antialias" val constructSettingsGtkXftAntialias :: Int32 -> IO ([Char], GValue) constructSettingsGtkXftAntialias val = constructObjectPropertyCInt "gtk-xft-antialias" val data SettingsGtkXftAntialiasPropertyInfo instance AttrInfo SettingsGtkXftAntialiasPropertyInfo where type AttrAllowedOps SettingsGtkXftAntialiasPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkXftAntialiasPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkXftAntialiasPropertyInfo = SettingsK type AttrGetType SettingsGtkXftAntialiasPropertyInfo = Int32 type AttrLabel SettingsGtkXftAntialiasPropertyInfo = "Settings::gtk-xft-antialias" attrGet _ = getSettingsGtkXftAntialias attrSet _ = setSettingsGtkXftAntialias attrConstruct _ = constructSettingsGtkXftAntialias -- VVV Prop "gtk-xft-dpi" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkXftDpi :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkXftDpi obj = liftIO $ getObjectPropertyCInt obj "gtk-xft-dpi" setSettingsGtkXftDpi :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkXftDpi obj val = liftIO $ setObjectPropertyCInt obj "gtk-xft-dpi" val constructSettingsGtkXftDpi :: Int32 -> IO ([Char], GValue) constructSettingsGtkXftDpi val = constructObjectPropertyCInt "gtk-xft-dpi" val data SettingsGtkXftDpiPropertyInfo instance AttrInfo SettingsGtkXftDpiPropertyInfo where type AttrAllowedOps SettingsGtkXftDpiPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkXftDpiPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkXftDpiPropertyInfo = SettingsK type AttrGetType SettingsGtkXftDpiPropertyInfo = Int32 type AttrLabel SettingsGtkXftDpiPropertyInfo = "Settings::gtk-xft-dpi" attrGet _ = getSettingsGtkXftDpi attrSet _ = setSettingsGtkXftDpi attrConstruct _ = constructSettingsGtkXftDpi -- VVV Prop "gtk-xft-hinting" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkXftHinting :: (MonadIO m, SettingsK o) => o -> m Int32 getSettingsGtkXftHinting obj = liftIO $ getObjectPropertyCInt obj "gtk-xft-hinting" setSettingsGtkXftHinting :: (MonadIO m, SettingsK o) => o -> Int32 -> m () setSettingsGtkXftHinting obj val = liftIO $ setObjectPropertyCInt obj "gtk-xft-hinting" val constructSettingsGtkXftHinting :: Int32 -> IO ([Char], GValue) constructSettingsGtkXftHinting val = constructObjectPropertyCInt "gtk-xft-hinting" val data SettingsGtkXftHintingPropertyInfo instance AttrInfo SettingsGtkXftHintingPropertyInfo where type AttrAllowedOps SettingsGtkXftHintingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkXftHintingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SettingsGtkXftHintingPropertyInfo = SettingsK type AttrGetType SettingsGtkXftHintingPropertyInfo = Int32 type AttrLabel SettingsGtkXftHintingPropertyInfo = "Settings::gtk-xft-hinting" attrGet _ = getSettingsGtkXftHinting attrSet _ = setSettingsGtkXftHinting attrConstruct _ = constructSettingsGtkXftHinting -- VVV Prop "gtk-xft-hintstyle" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkXftHintstyle :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkXftHintstyle obj = liftIO $ getObjectPropertyString obj "gtk-xft-hintstyle" setSettingsGtkXftHintstyle :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkXftHintstyle obj val = liftIO $ setObjectPropertyString obj "gtk-xft-hintstyle" val constructSettingsGtkXftHintstyle :: T.Text -> IO ([Char], GValue) constructSettingsGtkXftHintstyle val = constructObjectPropertyString "gtk-xft-hintstyle" val data SettingsGtkXftHintstylePropertyInfo instance AttrInfo SettingsGtkXftHintstylePropertyInfo where type AttrAllowedOps SettingsGtkXftHintstylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkXftHintstylePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkXftHintstylePropertyInfo = SettingsK type AttrGetType SettingsGtkXftHintstylePropertyInfo = T.Text type AttrLabel SettingsGtkXftHintstylePropertyInfo = "Settings::gtk-xft-hintstyle" attrGet _ = getSettingsGtkXftHintstyle attrSet _ = setSettingsGtkXftHintstyle attrConstruct _ = constructSettingsGtkXftHintstyle -- VVV Prop "gtk-xft-rgba" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSettingsGtkXftRgba :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsGtkXftRgba obj = liftIO $ getObjectPropertyString obj "gtk-xft-rgba" setSettingsGtkXftRgba :: (MonadIO m, SettingsK o) => o -> T.Text -> m () setSettingsGtkXftRgba obj val = liftIO $ setObjectPropertyString obj "gtk-xft-rgba" val constructSettingsGtkXftRgba :: T.Text -> IO ([Char], GValue) constructSettingsGtkXftRgba val = constructObjectPropertyString "gtk-xft-rgba" val data SettingsGtkXftRgbaPropertyInfo instance AttrInfo SettingsGtkXftRgbaPropertyInfo where type AttrAllowedOps SettingsGtkXftRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsGtkXftRgbaPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsGtkXftRgbaPropertyInfo = SettingsK type AttrGetType SettingsGtkXftRgbaPropertyInfo = T.Text type AttrLabel SettingsGtkXftRgbaPropertyInfo = "Settings::gtk-xft-rgba" attrGet _ = getSettingsGtkXftRgba attrSet _ = setSettingsGtkXftRgba attrConstruct _ = constructSettingsGtkXftRgba type instance AttributeList Settings = '[ '("color-hash", SettingsColorHashPropertyInfo), '("gtk-alternative-button-order", SettingsGtkAlternativeButtonOrderPropertyInfo), '("gtk-alternative-sort-arrows", SettingsGtkAlternativeSortArrowsPropertyInfo), '("gtk-application-prefer-dark-theme", SettingsGtkApplicationPreferDarkThemePropertyInfo), '("gtk-auto-mnemonics", SettingsGtkAutoMnemonicsPropertyInfo), '("gtk-button-images", SettingsGtkButtonImagesPropertyInfo), '("gtk-can-change-accels", SettingsGtkCanChangeAccelsPropertyInfo), '("gtk-color-palette", SettingsGtkColorPalettePropertyInfo), '("gtk-color-scheme", SettingsGtkColorSchemePropertyInfo), '("gtk-cursor-blink", SettingsGtkCursorBlinkPropertyInfo), '("gtk-cursor-blink-time", SettingsGtkCursorBlinkTimePropertyInfo), '("gtk-cursor-blink-timeout", SettingsGtkCursorBlinkTimeoutPropertyInfo), '("gtk-cursor-theme-name", SettingsGtkCursorThemeNamePropertyInfo), '("gtk-cursor-theme-size", SettingsGtkCursorThemeSizePropertyInfo), '("gtk-decoration-layout", SettingsGtkDecorationLayoutPropertyInfo), '("gtk-dialogs-use-header", SettingsGtkDialogsUseHeaderPropertyInfo), '("gtk-dnd-drag-threshold", SettingsGtkDndDragThresholdPropertyInfo), '("gtk-double-click-distance", SettingsGtkDoubleClickDistancePropertyInfo), '("gtk-double-click-time", SettingsGtkDoubleClickTimePropertyInfo), '("gtk-enable-accels", SettingsGtkEnableAccelsPropertyInfo), '("gtk-enable-animations", SettingsGtkEnableAnimationsPropertyInfo), '("gtk-enable-event-sounds", SettingsGtkEnableEventSoundsPropertyInfo), '("gtk-enable-input-feedback-sounds", SettingsGtkEnableInputFeedbackSoundsPropertyInfo), '("gtk-enable-mnemonics", SettingsGtkEnableMnemonicsPropertyInfo), '("gtk-enable-primary-paste", SettingsGtkEnablePrimaryPastePropertyInfo), '("gtk-enable-tooltips", SettingsGtkEnableTooltipsPropertyInfo), '("gtk-entry-password-hint-timeout", SettingsGtkEntryPasswordHintTimeoutPropertyInfo), '("gtk-entry-select-on-focus", SettingsGtkEntrySelectOnFocusPropertyInfo), '("gtk-error-bell", SettingsGtkErrorBellPropertyInfo), '("gtk-fallback-icon-theme", SettingsGtkFallbackIconThemePropertyInfo), '("gtk-file-chooser-backend", SettingsGtkFileChooserBackendPropertyInfo), '("gtk-font-name", SettingsGtkFontNamePropertyInfo), '("gtk-fontconfig-timestamp", SettingsGtkFontconfigTimestampPropertyInfo), '("gtk-icon-sizes", SettingsGtkIconSizesPropertyInfo), '("gtk-icon-theme-name", SettingsGtkIconThemeNamePropertyInfo), '("gtk-im-module", SettingsGtkImModulePropertyInfo), '("gtk-im-preedit-style", SettingsGtkImPreeditStylePropertyInfo), '("gtk-im-status-style", SettingsGtkImStatusStylePropertyInfo), '("gtk-key-theme-name", SettingsGtkKeyThemeNamePropertyInfo), '("gtk-keynav-cursor-only", SettingsGtkKeynavCursorOnlyPropertyInfo), '("gtk-keynav-wrap-around", SettingsGtkKeynavWrapAroundPropertyInfo), '("gtk-label-select-on-focus", SettingsGtkLabelSelectOnFocusPropertyInfo), '("gtk-long-press-time", SettingsGtkLongPressTimePropertyInfo), '("gtk-menu-bar-accel", SettingsGtkMenuBarAccelPropertyInfo), '("gtk-menu-bar-popup-delay", SettingsGtkMenuBarPopupDelayPropertyInfo), '("gtk-menu-images", SettingsGtkMenuImagesPropertyInfo), '("gtk-menu-popdown-delay", SettingsGtkMenuPopdownDelayPropertyInfo), '("gtk-menu-popup-delay", SettingsGtkMenuPopupDelayPropertyInfo), '("gtk-modules", SettingsGtkModulesPropertyInfo), '("gtk-primary-button-warps-slider", SettingsGtkPrimaryButtonWarpsSliderPropertyInfo), '("gtk-print-backends", SettingsGtkPrintBackendsPropertyInfo), '("gtk-print-preview-command", SettingsGtkPrintPreviewCommandPropertyInfo), '("gtk-recent-files-enabled", SettingsGtkRecentFilesEnabledPropertyInfo), '("gtk-recent-files-limit", SettingsGtkRecentFilesLimitPropertyInfo), '("gtk-recent-files-max-age", SettingsGtkRecentFilesMaxAgePropertyInfo), '("gtk-scrolled-window-placement", SettingsGtkScrolledWindowPlacementPropertyInfo), '("gtk-shell-shows-app-menu", SettingsGtkShellShowsAppMenuPropertyInfo), '("gtk-shell-shows-desktop", SettingsGtkShellShowsDesktopPropertyInfo), '("gtk-shell-shows-menubar", SettingsGtkShellShowsMenubarPropertyInfo), '("gtk-show-input-method-menu", SettingsGtkShowInputMethodMenuPropertyInfo), '("gtk-show-unicode-menu", SettingsGtkShowUnicodeMenuPropertyInfo), '("gtk-sound-theme-name", SettingsGtkSoundThemeNamePropertyInfo), '("gtk-split-cursor", SettingsGtkSplitCursorPropertyInfo), '("gtk-theme-name", SettingsGtkThemeNamePropertyInfo), '("gtk-timeout-expand", SettingsGtkTimeoutExpandPropertyInfo), '("gtk-timeout-initial", SettingsGtkTimeoutInitialPropertyInfo), '("gtk-timeout-repeat", SettingsGtkTimeoutRepeatPropertyInfo), '("gtk-titlebar-double-click", SettingsGtkTitlebarDoubleClickPropertyInfo), '("gtk-titlebar-middle-click", SettingsGtkTitlebarMiddleClickPropertyInfo), '("gtk-titlebar-right-click", SettingsGtkTitlebarRightClickPropertyInfo), '("gtk-toolbar-icon-size", SettingsGtkToolbarIconSizePropertyInfo), '("gtk-toolbar-style", SettingsGtkToolbarStylePropertyInfo), '("gtk-tooltip-browse-mode-timeout", SettingsGtkTooltipBrowseModeTimeoutPropertyInfo), '("gtk-tooltip-browse-timeout", SettingsGtkTooltipBrowseTimeoutPropertyInfo), '("gtk-tooltip-timeout", SettingsGtkTooltipTimeoutPropertyInfo), '("gtk-touchscreen-mode", SettingsGtkTouchscreenModePropertyInfo), '("gtk-visible-focus", SettingsGtkVisibleFocusPropertyInfo), '("gtk-xft-antialias", SettingsGtkXftAntialiasPropertyInfo), '("gtk-xft-dpi", SettingsGtkXftDpiPropertyInfo), '("gtk-xft-hinting", SettingsGtkXftHintingPropertyInfo), '("gtk-xft-hintstyle", SettingsGtkXftHintstylePropertyInfo), '("gtk-xft-rgba", SettingsGtkXftRgbaPropertyInfo)] -- VVV Prop "ignore-hidden" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSizeGroupIgnoreHidden :: (MonadIO m, SizeGroupK o) => o -> m Bool getSizeGroupIgnoreHidden obj = liftIO $ getObjectPropertyBool obj "ignore-hidden" setSizeGroupIgnoreHidden :: (MonadIO m, SizeGroupK o) => o -> Bool -> m () setSizeGroupIgnoreHidden obj val = liftIO $ setObjectPropertyBool obj "ignore-hidden" val constructSizeGroupIgnoreHidden :: Bool -> IO ([Char], GValue) constructSizeGroupIgnoreHidden val = constructObjectPropertyBool "ignore-hidden" val data SizeGroupIgnoreHiddenPropertyInfo instance AttrInfo SizeGroupIgnoreHiddenPropertyInfo where type AttrAllowedOps SizeGroupIgnoreHiddenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SizeGroupIgnoreHiddenPropertyInfo = (~) Bool type AttrBaseTypeConstraint SizeGroupIgnoreHiddenPropertyInfo = SizeGroupK type AttrGetType SizeGroupIgnoreHiddenPropertyInfo = Bool type AttrLabel SizeGroupIgnoreHiddenPropertyInfo = "SizeGroup::ignore-hidden" attrGet _ = getSizeGroupIgnoreHidden attrSet _ = setSizeGroupIgnoreHidden attrConstruct _ = constructSizeGroupIgnoreHidden -- VVV Prop "mode" -- Type: TInterface "Gtk" "SizeGroupMode" -- Flags: [PropertyReadable,PropertyWritable] getSizeGroupMode :: (MonadIO m, SizeGroupK o) => o -> m SizeGroupMode getSizeGroupMode obj = liftIO $ getObjectPropertyEnum obj "mode" setSizeGroupMode :: (MonadIO m, SizeGroupK o) => o -> SizeGroupMode -> m () setSizeGroupMode obj val = liftIO $ setObjectPropertyEnum obj "mode" val constructSizeGroupMode :: SizeGroupMode -> IO ([Char], GValue) constructSizeGroupMode val = constructObjectPropertyEnum "mode" val data SizeGroupModePropertyInfo instance AttrInfo SizeGroupModePropertyInfo where type AttrAllowedOps SizeGroupModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SizeGroupModePropertyInfo = (~) SizeGroupMode type AttrBaseTypeConstraint SizeGroupModePropertyInfo = SizeGroupK type AttrGetType SizeGroupModePropertyInfo = SizeGroupMode type AttrLabel SizeGroupModePropertyInfo = "SizeGroup::mode" attrGet _ = getSizeGroupMode attrSet _ = setSizeGroupMode attrConstruct _ = constructSizeGroupMode type instance AttributeList SizeGroup = '[ '("ignore-hidden", SizeGroupIgnoreHiddenPropertyInfo), '("mode", SizeGroupModePropertyInfo)] type instance AttributeList Socket = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "adjustment" -- Type: TInterface "Gtk" "Adjustment" -- Flags: [PropertyReadable,PropertyWritable] getSpinButtonAdjustment :: (MonadIO m, SpinButtonK o) => o -> m Adjustment getSpinButtonAdjustment obj = liftIO $ getObjectPropertyObject obj "adjustment" Adjustment setSpinButtonAdjustment :: (MonadIO m, SpinButtonK o, AdjustmentK a) => o -> a -> m () setSpinButtonAdjustment obj val = liftIO $ setObjectPropertyObject obj "adjustment" val constructSpinButtonAdjustment :: (AdjustmentK a) => a -> IO ([Char], GValue) constructSpinButtonAdjustment val = constructObjectPropertyObject "adjustment" val data SpinButtonAdjustmentPropertyInfo instance AttrInfo SpinButtonAdjustmentPropertyInfo where type AttrAllowedOps SpinButtonAdjustmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SpinButtonAdjustmentPropertyInfo = AdjustmentK type AttrBaseTypeConstraint SpinButtonAdjustmentPropertyInfo = SpinButtonK type AttrGetType SpinButtonAdjustmentPropertyInfo = Adjustment type AttrLabel SpinButtonAdjustmentPropertyInfo = "SpinButton::adjustment" attrGet _ = getSpinButtonAdjustment attrSet _ = setSpinButtonAdjustment attrConstruct _ = constructSpinButtonAdjustment -- VVV Prop "climb-rate" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getSpinButtonClimbRate :: (MonadIO m, SpinButtonK o) => o -> m Double getSpinButtonClimbRate obj = liftIO $ getObjectPropertyDouble obj "climb-rate" setSpinButtonClimbRate :: (MonadIO m, SpinButtonK o) => o -> Double -> m () setSpinButtonClimbRate obj val = liftIO $ setObjectPropertyDouble obj "climb-rate" val constructSpinButtonClimbRate :: Double -> IO ([Char], GValue) constructSpinButtonClimbRate val = constructObjectPropertyDouble "climb-rate" val data SpinButtonClimbRatePropertyInfo instance AttrInfo SpinButtonClimbRatePropertyInfo where type AttrAllowedOps SpinButtonClimbRatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SpinButtonClimbRatePropertyInfo = (~) Double type AttrBaseTypeConstraint SpinButtonClimbRatePropertyInfo = SpinButtonK type AttrGetType SpinButtonClimbRatePropertyInfo = Double type AttrLabel SpinButtonClimbRatePropertyInfo = "SpinButton::climb-rate" attrGet _ = getSpinButtonClimbRate attrSet _ = setSpinButtonClimbRate attrConstruct _ = constructSpinButtonClimbRate -- VVV Prop "digits" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getSpinButtonDigits :: (MonadIO m, SpinButtonK o) => o -> m Word32 getSpinButtonDigits obj = liftIO $ getObjectPropertyCUInt obj "digits" setSpinButtonDigits :: (MonadIO m, SpinButtonK o) => o -> Word32 -> m () setSpinButtonDigits obj val = liftIO $ setObjectPropertyCUInt obj "digits" val constructSpinButtonDigits :: Word32 -> IO ([Char], GValue) constructSpinButtonDigits val = constructObjectPropertyCUInt "digits" val data SpinButtonDigitsPropertyInfo instance AttrInfo SpinButtonDigitsPropertyInfo where type AttrAllowedOps SpinButtonDigitsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SpinButtonDigitsPropertyInfo = (~) Word32 type AttrBaseTypeConstraint SpinButtonDigitsPropertyInfo = SpinButtonK type AttrGetType SpinButtonDigitsPropertyInfo = Word32 type AttrLabel SpinButtonDigitsPropertyInfo = "SpinButton::digits" attrGet _ = getSpinButtonDigits attrSet _ = setSpinButtonDigits attrConstruct _ = constructSpinButtonDigits -- VVV Prop "numeric" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSpinButtonNumeric :: (MonadIO m, SpinButtonK o) => o -> m Bool getSpinButtonNumeric obj = liftIO $ getObjectPropertyBool obj "numeric" setSpinButtonNumeric :: (MonadIO m, SpinButtonK o) => o -> Bool -> m () setSpinButtonNumeric obj val = liftIO $ setObjectPropertyBool obj "numeric" val constructSpinButtonNumeric :: Bool -> IO ([Char], GValue) constructSpinButtonNumeric val = constructObjectPropertyBool "numeric" val data SpinButtonNumericPropertyInfo instance AttrInfo SpinButtonNumericPropertyInfo where type AttrAllowedOps SpinButtonNumericPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SpinButtonNumericPropertyInfo = (~) Bool type AttrBaseTypeConstraint SpinButtonNumericPropertyInfo = SpinButtonK type AttrGetType SpinButtonNumericPropertyInfo = Bool type AttrLabel SpinButtonNumericPropertyInfo = "SpinButton::numeric" attrGet _ = getSpinButtonNumeric attrSet _ = setSpinButtonNumeric attrConstruct _ = constructSpinButtonNumeric -- VVV Prop "snap-to-ticks" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSpinButtonSnapToTicks :: (MonadIO m, SpinButtonK o) => o -> m Bool getSpinButtonSnapToTicks obj = liftIO $ getObjectPropertyBool obj "snap-to-ticks" setSpinButtonSnapToTicks :: (MonadIO m, SpinButtonK o) => o -> Bool -> m () setSpinButtonSnapToTicks obj val = liftIO $ setObjectPropertyBool obj "snap-to-ticks" val constructSpinButtonSnapToTicks :: Bool -> IO ([Char], GValue) constructSpinButtonSnapToTicks val = constructObjectPropertyBool "snap-to-ticks" val data SpinButtonSnapToTicksPropertyInfo instance AttrInfo SpinButtonSnapToTicksPropertyInfo where type AttrAllowedOps SpinButtonSnapToTicksPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SpinButtonSnapToTicksPropertyInfo = (~) Bool type AttrBaseTypeConstraint SpinButtonSnapToTicksPropertyInfo = SpinButtonK type AttrGetType SpinButtonSnapToTicksPropertyInfo = Bool type AttrLabel SpinButtonSnapToTicksPropertyInfo = "SpinButton::snap-to-ticks" attrGet _ = getSpinButtonSnapToTicks attrSet _ = setSpinButtonSnapToTicks attrConstruct _ = constructSpinButtonSnapToTicks -- VVV Prop "update-policy" -- Type: TInterface "Gtk" "SpinButtonUpdatePolicy" -- Flags: [PropertyReadable,PropertyWritable] getSpinButtonUpdatePolicy :: (MonadIO m, SpinButtonK o) => o -> m SpinButtonUpdatePolicy getSpinButtonUpdatePolicy obj = liftIO $ getObjectPropertyEnum obj "update-policy" setSpinButtonUpdatePolicy :: (MonadIO m, SpinButtonK o) => o -> SpinButtonUpdatePolicy -> m () setSpinButtonUpdatePolicy obj val = liftIO $ setObjectPropertyEnum obj "update-policy" val constructSpinButtonUpdatePolicy :: SpinButtonUpdatePolicy -> IO ([Char], GValue) constructSpinButtonUpdatePolicy val = constructObjectPropertyEnum "update-policy" val data SpinButtonUpdatePolicyPropertyInfo instance AttrInfo SpinButtonUpdatePolicyPropertyInfo where type AttrAllowedOps SpinButtonUpdatePolicyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SpinButtonUpdatePolicyPropertyInfo = (~) SpinButtonUpdatePolicy type AttrBaseTypeConstraint SpinButtonUpdatePolicyPropertyInfo = SpinButtonK type AttrGetType SpinButtonUpdatePolicyPropertyInfo = SpinButtonUpdatePolicy type AttrLabel SpinButtonUpdatePolicyPropertyInfo = "SpinButton::update-policy" attrGet _ = getSpinButtonUpdatePolicy attrSet _ = setSpinButtonUpdatePolicy attrConstruct _ = constructSpinButtonUpdatePolicy -- VVV Prop "value" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getSpinButtonValue :: (MonadIO m, SpinButtonK o) => o -> m Double getSpinButtonValue obj = liftIO $ getObjectPropertyDouble obj "value" setSpinButtonValue :: (MonadIO m, SpinButtonK o) => o -> Double -> m () setSpinButtonValue obj val = liftIO $ setObjectPropertyDouble obj "value" val constructSpinButtonValue :: Double -> IO ([Char], GValue) constructSpinButtonValue val = constructObjectPropertyDouble "value" val data SpinButtonValuePropertyInfo instance AttrInfo SpinButtonValuePropertyInfo where type AttrAllowedOps SpinButtonValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SpinButtonValuePropertyInfo = (~) Double type AttrBaseTypeConstraint SpinButtonValuePropertyInfo = SpinButtonK type AttrGetType SpinButtonValuePropertyInfo = Double type AttrLabel SpinButtonValuePropertyInfo = "SpinButton::value" attrGet _ = getSpinButtonValue attrSet _ = setSpinButtonValue attrConstruct _ = constructSpinButtonValue -- VVV Prop "wrap" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSpinButtonWrap :: (MonadIO m, SpinButtonK o) => o -> m Bool getSpinButtonWrap obj = liftIO $ getObjectPropertyBool obj "wrap" setSpinButtonWrap :: (MonadIO m, SpinButtonK o) => o -> Bool -> m () setSpinButtonWrap obj val = liftIO $ setObjectPropertyBool obj "wrap" val constructSpinButtonWrap :: Bool -> IO ([Char], GValue) constructSpinButtonWrap val = constructObjectPropertyBool "wrap" val data SpinButtonWrapPropertyInfo instance AttrInfo SpinButtonWrapPropertyInfo where type AttrAllowedOps SpinButtonWrapPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SpinButtonWrapPropertyInfo = (~) Bool type AttrBaseTypeConstraint SpinButtonWrapPropertyInfo = SpinButtonK type AttrGetType SpinButtonWrapPropertyInfo = Bool type AttrLabel SpinButtonWrapPropertyInfo = "SpinButton::wrap" attrGet _ = getSpinButtonWrap attrSet _ = setSpinButtonWrap attrConstruct _ = constructSpinButtonWrap type instance AttributeList SpinButton = '[ '("activates-default", EntryActivatesDefaultPropertyInfo), '("adjustment", SpinButtonAdjustmentPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("attributes", EntryAttributesPropertyInfo), '("buffer", EntryBufferPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("caps-lock-warning", EntryCapsLockWarningPropertyInfo), '("climb-rate", SpinButtonClimbRatePropertyInfo), '("completion", EntryCompletionPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("cursor-position", EntryCursorPositionPropertyInfo), '("digits", SpinButtonDigitsPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("editable", EntryEditablePropertyInfo), '("editing-canceled", CellEditableEditingCanceledPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-frame", EntryHasFramePropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("im-module", EntryImModulePropertyInfo), '("inner-border", EntryInnerBorderPropertyInfo), '("input-hints", EntryInputHintsPropertyInfo), '("input-purpose", EntryInputPurposePropertyInfo), '("invisible-char", EntryInvisibleCharPropertyInfo), '("invisible-char-set", EntryInvisibleCharSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-length", EntryMaxLengthPropertyInfo), '("max-width-chars", EntryMaxWidthCharsPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("numeric", SpinButtonNumericPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("overwrite-mode", EntryOverwriteModePropertyInfo), '("parent", WidgetParentPropertyInfo), '("placeholder-text", EntryPlaceholderTextPropertyInfo), '("populate-all", EntryPopulateAllPropertyInfo), '("primary-icon-activatable", EntryPrimaryIconActivatablePropertyInfo), '("primary-icon-gicon", EntryPrimaryIconGiconPropertyInfo), '("primary-icon-name", EntryPrimaryIconNamePropertyInfo), '("primary-icon-pixbuf", EntryPrimaryIconPixbufPropertyInfo), '("primary-icon-sensitive", EntryPrimaryIconSensitivePropertyInfo), '("primary-icon-stock", EntryPrimaryIconStockPropertyInfo), '("primary-icon-storage-type", EntryPrimaryIconStorageTypePropertyInfo), '("primary-icon-tooltip-markup", EntryPrimaryIconTooltipMarkupPropertyInfo), '("primary-icon-tooltip-text", EntryPrimaryIconTooltipTextPropertyInfo), '("progress-fraction", EntryProgressFractionPropertyInfo), '("progress-pulse-step", EntryProgressPulseStepPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("scroll-offset", EntryScrollOffsetPropertyInfo), '("secondary-icon-activatable", EntrySecondaryIconActivatablePropertyInfo), '("secondary-icon-gicon", EntrySecondaryIconGiconPropertyInfo), '("secondary-icon-name", EntrySecondaryIconNamePropertyInfo), '("secondary-icon-pixbuf", EntrySecondaryIconPixbufPropertyInfo), '("secondary-icon-sensitive", EntrySecondaryIconSensitivePropertyInfo), '("secondary-icon-stock", EntrySecondaryIconStockPropertyInfo), '("secondary-icon-storage-type", EntrySecondaryIconStorageTypePropertyInfo), '("secondary-icon-tooltip-markup", EntrySecondaryIconTooltipMarkupPropertyInfo), '("secondary-icon-tooltip-text", EntrySecondaryIconTooltipTextPropertyInfo), '("selection-bound", EntrySelectionBoundPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", EntryShadowTypePropertyInfo), '("snap-to-ticks", SpinButtonSnapToTicksPropertyInfo), '("style", WidgetStylePropertyInfo), '("tabs", EntryTabsPropertyInfo), '("text", EntryTextPropertyInfo), '("text-length", EntryTextLengthPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("truncate-multiline", EntryTruncateMultilinePropertyInfo), '("update-policy", SpinButtonUpdatePolicyPropertyInfo), '("valign", WidgetValignPropertyInfo), '("value", SpinButtonValuePropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visibility", EntryVisibilityPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-chars", EntryWidthCharsPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("wrap", SpinButtonWrapPropertyInfo), '("xalign", EntryXalignPropertyInfo)] type instance AttributeList SpinButtonAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSpinnerActive :: (MonadIO m, SpinnerK o) => o -> m Bool getSpinnerActive obj = liftIO $ getObjectPropertyBool obj "active" setSpinnerActive :: (MonadIO m, SpinnerK o) => o -> Bool -> m () setSpinnerActive obj val = liftIO $ setObjectPropertyBool obj "active" val constructSpinnerActive :: Bool -> IO ([Char], GValue) constructSpinnerActive val = constructObjectPropertyBool "active" val data SpinnerActivePropertyInfo instance AttrInfo SpinnerActivePropertyInfo where type AttrAllowedOps SpinnerActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SpinnerActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint SpinnerActivePropertyInfo = SpinnerK type AttrGetType SpinnerActivePropertyInfo = Bool type AttrLabel SpinnerActivePropertyInfo = "Spinner::active" attrGet _ = getSpinnerActive attrSet _ = setSpinnerActive attrConstruct _ = constructSpinnerActive type instance AttributeList Spinner = '[ '("active", SpinnerActivePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList SpinnerAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "hhomogeneous" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getStackHhomogeneous :: (MonadIO m, StackK o) => o -> m Bool getStackHhomogeneous obj = liftIO $ getObjectPropertyBool obj "hhomogeneous" setStackHhomogeneous :: (MonadIO m, StackK o) => o -> Bool -> m () setStackHhomogeneous obj val = liftIO $ setObjectPropertyBool obj "hhomogeneous" val constructStackHhomogeneous :: Bool -> IO ([Char], GValue) constructStackHhomogeneous val = constructObjectPropertyBool "hhomogeneous" val data StackHhomogeneousPropertyInfo instance AttrInfo StackHhomogeneousPropertyInfo where type AttrAllowedOps StackHhomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StackHhomogeneousPropertyInfo = (~) Bool type AttrBaseTypeConstraint StackHhomogeneousPropertyInfo = StackK type AttrGetType StackHhomogeneousPropertyInfo = Bool type AttrLabel StackHhomogeneousPropertyInfo = "Stack::hhomogeneous" attrGet _ = getStackHhomogeneous attrSet _ = setStackHhomogeneous attrConstruct _ = constructStackHhomogeneous -- VVV Prop "homogeneous" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getStackHomogeneous :: (MonadIO m, StackK o) => o -> m Bool getStackHomogeneous obj = liftIO $ getObjectPropertyBool obj "homogeneous" setStackHomogeneous :: (MonadIO m, StackK o) => o -> Bool -> m () setStackHomogeneous obj val = liftIO $ setObjectPropertyBool obj "homogeneous" val constructStackHomogeneous :: Bool -> IO ([Char], GValue) constructStackHomogeneous val = constructObjectPropertyBool "homogeneous" val data StackHomogeneousPropertyInfo instance AttrInfo StackHomogeneousPropertyInfo where type AttrAllowedOps StackHomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StackHomogeneousPropertyInfo = (~) Bool type AttrBaseTypeConstraint StackHomogeneousPropertyInfo = StackK type AttrGetType StackHomogeneousPropertyInfo = Bool type AttrLabel StackHomogeneousPropertyInfo = "Stack::homogeneous" attrGet _ = getStackHomogeneous attrSet _ = setStackHomogeneous attrConstruct _ = constructStackHomogeneous -- VVV Prop "interpolate-size" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getStackInterpolateSize :: (MonadIO m, StackK o) => o -> m Bool getStackInterpolateSize obj = liftIO $ getObjectPropertyBool obj "interpolate-size" setStackInterpolateSize :: (MonadIO m, StackK o) => o -> Bool -> m () setStackInterpolateSize obj val = liftIO $ setObjectPropertyBool obj "interpolate-size" val constructStackInterpolateSize :: Bool -> IO ([Char], GValue) constructStackInterpolateSize val = constructObjectPropertyBool "interpolate-size" val data StackInterpolateSizePropertyInfo instance AttrInfo StackInterpolateSizePropertyInfo where type AttrAllowedOps StackInterpolateSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StackInterpolateSizePropertyInfo = (~) Bool type AttrBaseTypeConstraint StackInterpolateSizePropertyInfo = StackK type AttrGetType StackInterpolateSizePropertyInfo = Bool type AttrLabel StackInterpolateSizePropertyInfo = "Stack::interpolate-size" attrGet _ = getStackInterpolateSize attrSet _ = setStackInterpolateSize attrConstruct _ = constructStackInterpolateSize -- VVV Prop "transition-duration" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getStackTransitionDuration :: (MonadIO m, StackK o) => o -> m Word32 getStackTransitionDuration obj = liftIO $ getObjectPropertyCUInt obj "transition-duration" setStackTransitionDuration :: (MonadIO m, StackK o) => o -> Word32 -> m () setStackTransitionDuration obj val = liftIO $ setObjectPropertyCUInt obj "transition-duration" val constructStackTransitionDuration :: Word32 -> IO ([Char], GValue) constructStackTransitionDuration val = constructObjectPropertyCUInt "transition-duration" val data StackTransitionDurationPropertyInfo instance AttrInfo StackTransitionDurationPropertyInfo where type AttrAllowedOps StackTransitionDurationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StackTransitionDurationPropertyInfo = (~) Word32 type AttrBaseTypeConstraint StackTransitionDurationPropertyInfo = StackK type AttrGetType StackTransitionDurationPropertyInfo = Word32 type AttrLabel StackTransitionDurationPropertyInfo = "Stack::transition-duration" attrGet _ = getStackTransitionDuration attrSet _ = setStackTransitionDuration attrConstruct _ = constructStackTransitionDuration -- VVV Prop "transition-running" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getStackTransitionRunning :: (MonadIO m, StackK o) => o -> m Bool getStackTransitionRunning obj = liftIO $ getObjectPropertyBool obj "transition-running" data StackTransitionRunningPropertyInfo instance AttrInfo StackTransitionRunningPropertyInfo where type AttrAllowedOps StackTransitionRunningPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint StackTransitionRunningPropertyInfo = (~) () type AttrBaseTypeConstraint StackTransitionRunningPropertyInfo = StackK type AttrGetType StackTransitionRunningPropertyInfo = Bool type AttrLabel StackTransitionRunningPropertyInfo = "Stack::transition-running" attrGet _ = getStackTransitionRunning attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "transition-type" -- Type: TInterface "Gtk" "StackTransitionType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getStackTransitionType :: (MonadIO m, StackK o) => o -> m StackTransitionType getStackTransitionType obj = liftIO $ getObjectPropertyEnum obj "transition-type" setStackTransitionType :: (MonadIO m, StackK o) => o -> StackTransitionType -> m () setStackTransitionType obj val = liftIO $ setObjectPropertyEnum obj "transition-type" val constructStackTransitionType :: StackTransitionType -> IO ([Char], GValue) constructStackTransitionType val = constructObjectPropertyEnum "transition-type" val data StackTransitionTypePropertyInfo instance AttrInfo StackTransitionTypePropertyInfo where type AttrAllowedOps StackTransitionTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StackTransitionTypePropertyInfo = (~) StackTransitionType type AttrBaseTypeConstraint StackTransitionTypePropertyInfo = StackK type AttrGetType StackTransitionTypePropertyInfo = StackTransitionType type AttrLabel StackTransitionTypePropertyInfo = "Stack::transition-type" attrGet _ = getStackTransitionType attrSet _ = setStackTransitionType attrConstruct _ = constructStackTransitionType -- VVV Prop "vhomogeneous" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getStackVhomogeneous :: (MonadIO m, StackK o) => o -> m Bool getStackVhomogeneous obj = liftIO $ getObjectPropertyBool obj "vhomogeneous" setStackVhomogeneous :: (MonadIO m, StackK o) => o -> Bool -> m () setStackVhomogeneous obj val = liftIO $ setObjectPropertyBool obj "vhomogeneous" val constructStackVhomogeneous :: Bool -> IO ([Char], GValue) constructStackVhomogeneous val = constructObjectPropertyBool "vhomogeneous" val data StackVhomogeneousPropertyInfo instance AttrInfo StackVhomogeneousPropertyInfo where type AttrAllowedOps StackVhomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StackVhomogeneousPropertyInfo = (~) Bool type AttrBaseTypeConstraint StackVhomogeneousPropertyInfo = StackK type AttrGetType StackVhomogeneousPropertyInfo = Bool type AttrLabel StackVhomogeneousPropertyInfo = "Stack::vhomogeneous" attrGet _ = getStackVhomogeneous attrSet _ = setStackVhomogeneous attrConstruct _ = constructStackVhomogeneous -- VVV Prop "visible-child" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getStackVisibleChild :: (MonadIO m, StackK o) => o -> m Widget getStackVisibleChild obj = liftIO $ getObjectPropertyObject obj "visible-child" Widget setStackVisibleChild :: (MonadIO m, StackK o, WidgetK a) => o -> a -> m () setStackVisibleChild obj val = liftIO $ setObjectPropertyObject obj "visible-child" val constructStackVisibleChild :: (WidgetK a) => a -> IO ([Char], GValue) constructStackVisibleChild val = constructObjectPropertyObject "visible-child" val data StackVisibleChildPropertyInfo instance AttrInfo StackVisibleChildPropertyInfo where type AttrAllowedOps StackVisibleChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StackVisibleChildPropertyInfo = WidgetK type AttrBaseTypeConstraint StackVisibleChildPropertyInfo = StackK type AttrGetType StackVisibleChildPropertyInfo = Widget type AttrLabel StackVisibleChildPropertyInfo = "Stack::visible-child" attrGet _ = getStackVisibleChild attrSet _ = setStackVisibleChild attrConstruct _ = constructStackVisibleChild -- VVV Prop "visible-child-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getStackVisibleChildName :: (MonadIO m, StackK o) => o -> m T.Text getStackVisibleChildName obj = liftIO $ getObjectPropertyString obj "visible-child-name" setStackVisibleChildName :: (MonadIO m, StackK o) => o -> T.Text -> m () setStackVisibleChildName obj val = liftIO $ setObjectPropertyString obj "visible-child-name" val constructStackVisibleChildName :: T.Text -> IO ([Char], GValue) constructStackVisibleChildName val = constructObjectPropertyString "visible-child-name" val data StackVisibleChildNamePropertyInfo instance AttrInfo StackVisibleChildNamePropertyInfo where type AttrAllowedOps StackVisibleChildNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StackVisibleChildNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint StackVisibleChildNamePropertyInfo = StackK type AttrGetType StackVisibleChildNamePropertyInfo = T.Text type AttrLabel StackVisibleChildNamePropertyInfo = "Stack::visible-child-name" attrGet _ = getStackVisibleChildName attrSet _ = setStackVisibleChildName attrConstruct _ = constructStackVisibleChildName type instance AttributeList Stack = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hhomogeneous", StackHhomogeneousPropertyInfo), '("homogeneous", StackHomogeneousPropertyInfo), '("interpolate-size", StackInterpolateSizePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transition-duration", StackTransitionDurationPropertyInfo), '("transition-running", StackTransitionRunningPropertyInfo), '("transition-type", StackTransitionTypePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("vhomogeneous", StackVhomogeneousPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("visible-child", StackVisibleChildPropertyInfo), '("visible-child-name", StackVisibleChildNamePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "stack" -- Type: TInterface "Gtk" "Stack" -- Flags: [PropertyReadable,PropertyWritable] getStackSidebarStack :: (MonadIO m, StackSidebarK o) => o -> m Stack getStackSidebarStack obj = liftIO $ getObjectPropertyObject obj "stack" Stack setStackSidebarStack :: (MonadIO m, StackSidebarK o, StackK a) => o -> a -> m () setStackSidebarStack obj val = liftIO $ setObjectPropertyObject obj "stack" val constructStackSidebarStack :: (StackK a) => a -> IO ([Char], GValue) constructStackSidebarStack val = constructObjectPropertyObject "stack" val data StackSidebarStackPropertyInfo instance AttrInfo StackSidebarStackPropertyInfo where type AttrAllowedOps StackSidebarStackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StackSidebarStackPropertyInfo = StackK type AttrBaseTypeConstraint StackSidebarStackPropertyInfo = StackSidebarK type AttrGetType StackSidebarStackPropertyInfo = Stack type AttrLabel StackSidebarStackPropertyInfo = "StackSidebar::stack" attrGet _ = getStackSidebarStack attrSet _ = setStackSidebarStack attrConstruct _ = constructStackSidebarStack type instance AttributeList StackSidebar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("stack", StackSidebarStackPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "stack" -- Type: TInterface "Gtk" "Stack" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getStackSwitcherStack :: (MonadIO m, StackSwitcherK o) => o -> m Stack getStackSwitcherStack obj = liftIO $ getObjectPropertyObject obj "stack" Stack setStackSwitcherStack :: (MonadIO m, StackSwitcherK o, StackK a) => o -> a -> m () setStackSwitcherStack obj val = liftIO $ setObjectPropertyObject obj "stack" val constructStackSwitcherStack :: (StackK a) => a -> IO ([Char], GValue) constructStackSwitcherStack val = constructObjectPropertyObject "stack" val data StackSwitcherStackPropertyInfo instance AttrInfo StackSwitcherStackPropertyInfo where type AttrAllowedOps StackSwitcherStackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StackSwitcherStackPropertyInfo = StackK type AttrBaseTypeConstraint StackSwitcherStackPropertyInfo = StackSwitcherK type AttrGetType StackSwitcherStackPropertyInfo = Stack type AttrLabel StackSwitcherStackPropertyInfo = "StackSwitcher::stack" attrGet _ = getStackSwitcherStack attrSet _ = setStackSwitcherStack attrConstruct _ = constructStackSwitcherStack type instance AttributeList StackSwitcher = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("stack", StackSwitcherStackPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "embedded" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getStatusIconEmbedded :: (MonadIO m, StatusIconK o) => o -> m Bool getStatusIconEmbedded obj = liftIO $ getObjectPropertyBool obj "embedded" data StatusIconEmbeddedPropertyInfo instance AttrInfo StatusIconEmbeddedPropertyInfo where type AttrAllowedOps StatusIconEmbeddedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint StatusIconEmbeddedPropertyInfo = (~) () type AttrBaseTypeConstraint StatusIconEmbeddedPropertyInfo = StatusIconK type AttrGetType StatusIconEmbeddedPropertyInfo = Bool type AttrLabel StatusIconEmbeddedPropertyInfo = "StatusIcon::embedded" attrGet _ = getStatusIconEmbedded attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "file" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setStatusIconFile :: (MonadIO m, StatusIconK o) => o -> T.Text -> m () setStatusIconFile obj val = liftIO $ setObjectPropertyString obj "file" val constructStatusIconFile :: T.Text -> IO ([Char], GValue) constructStatusIconFile val = constructObjectPropertyString "file" val data StatusIconFilePropertyInfo instance AttrInfo StatusIconFilePropertyInfo where type AttrAllowedOps StatusIconFilePropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint StatusIconFilePropertyInfo = (~) T.Text type AttrBaseTypeConstraint StatusIconFilePropertyInfo = StatusIconK type AttrGetType StatusIconFilePropertyInfo = () type AttrLabel StatusIconFilePropertyInfo = "StatusIcon::file" attrGet _ = undefined attrSet _ = setStatusIconFile attrConstruct _ = constructStatusIconFile -- VVV Prop "gicon" -- Type: TInterface "Gio" "Icon" -- Flags: [PropertyReadable,PropertyWritable] getStatusIconGicon :: (MonadIO m, StatusIconK o) => o -> m Gio.Icon getStatusIconGicon obj = liftIO $ getObjectPropertyObject obj "gicon" Gio.Icon setStatusIconGicon :: (MonadIO m, StatusIconK o, Gio.IconK a) => o -> a -> m () setStatusIconGicon obj val = liftIO $ setObjectPropertyObject obj "gicon" val constructStatusIconGicon :: (Gio.IconK a) => a -> IO ([Char], GValue) constructStatusIconGicon val = constructObjectPropertyObject "gicon" val data StatusIconGiconPropertyInfo instance AttrInfo StatusIconGiconPropertyInfo where type AttrAllowedOps StatusIconGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StatusIconGiconPropertyInfo = Gio.IconK type AttrBaseTypeConstraint StatusIconGiconPropertyInfo = StatusIconK type AttrGetType StatusIconGiconPropertyInfo = Gio.Icon type AttrLabel StatusIconGiconPropertyInfo = "StatusIcon::gicon" attrGet _ = getStatusIconGicon attrSet _ = setStatusIconGicon attrConstruct _ = constructStatusIconGicon -- VVV Prop "has-tooltip" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getStatusIconHasTooltip :: (MonadIO m, StatusIconK o) => o -> m Bool getStatusIconHasTooltip obj = liftIO $ getObjectPropertyBool obj "has-tooltip" setStatusIconHasTooltip :: (MonadIO m, StatusIconK o) => o -> Bool -> m () setStatusIconHasTooltip obj val = liftIO $ setObjectPropertyBool obj "has-tooltip" val constructStatusIconHasTooltip :: Bool -> IO ([Char], GValue) constructStatusIconHasTooltip val = constructObjectPropertyBool "has-tooltip" val data StatusIconHasTooltipPropertyInfo instance AttrInfo StatusIconHasTooltipPropertyInfo where type AttrAllowedOps StatusIconHasTooltipPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StatusIconHasTooltipPropertyInfo = (~) Bool type AttrBaseTypeConstraint StatusIconHasTooltipPropertyInfo = StatusIconK type AttrGetType StatusIconHasTooltipPropertyInfo = Bool type AttrLabel StatusIconHasTooltipPropertyInfo = "StatusIcon::has-tooltip" attrGet _ = getStatusIconHasTooltip attrSet _ = setStatusIconHasTooltip attrConstruct _ = constructStatusIconHasTooltip -- VVV Prop "icon-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getStatusIconIconName :: (MonadIO m, StatusIconK o) => o -> m T.Text getStatusIconIconName obj = liftIO $ getObjectPropertyString obj "icon-name" setStatusIconIconName :: (MonadIO m, StatusIconK o) => o -> T.Text -> m () setStatusIconIconName obj val = liftIO $ setObjectPropertyString obj "icon-name" val constructStatusIconIconName :: T.Text -> IO ([Char], GValue) constructStatusIconIconName val = constructObjectPropertyString "icon-name" val data StatusIconIconNamePropertyInfo instance AttrInfo StatusIconIconNamePropertyInfo where type AttrAllowedOps StatusIconIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StatusIconIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint StatusIconIconNamePropertyInfo = StatusIconK type AttrGetType StatusIconIconNamePropertyInfo = T.Text type AttrLabel StatusIconIconNamePropertyInfo = "StatusIcon::icon-name" attrGet _ = getStatusIconIconName attrSet _ = setStatusIconIconName attrConstruct _ = constructStatusIconIconName -- VVV Prop "orientation" -- Type: TInterface "Gtk" "Orientation" -- Flags: [PropertyReadable] getStatusIconOrientation :: (MonadIO m, StatusIconK o) => o -> m Orientation getStatusIconOrientation obj = liftIO $ getObjectPropertyEnum obj "orientation" data StatusIconOrientationPropertyInfo instance AttrInfo StatusIconOrientationPropertyInfo where type AttrAllowedOps StatusIconOrientationPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint StatusIconOrientationPropertyInfo = (~) () type AttrBaseTypeConstraint StatusIconOrientationPropertyInfo = StatusIconK type AttrGetType StatusIconOrientationPropertyInfo = Orientation type AttrLabel StatusIconOrientationPropertyInfo = "StatusIcon::orientation" attrGet _ = getStatusIconOrientation attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "pixbuf" -- Type: TInterface "GdkPixbuf" "Pixbuf" -- Flags: [PropertyReadable,PropertyWritable] getStatusIconPixbuf :: (MonadIO m, StatusIconK o) => o -> m GdkPixbuf.Pixbuf getStatusIconPixbuf obj = liftIO $ getObjectPropertyObject obj "pixbuf" GdkPixbuf.Pixbuf setStatusIconPixbuf :: (MonadIO m, StatusIconK o, GdkPixbuf.PixbufK a) => o -> a -> m () setStatusIconPixbuf obj val = liftIO $ setObjectPropertyObject obj "pixbuf" val constructStatusIconPixbuf :: (GdkPixbuf.PixbufK a) => a -> IO ([Char], GValue) constructStatusIconPixbuf val = constructObjectPropertyObject "pixbuf" val data StatusIconPixbufPropertyInfo instance AttrInfo StatusIconPixbufPropertyInfo where type AttrAllowedOps StatusIconPixbufPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StatusIconPixbufPropertyInfo = GdkPixbuf.PixbufK type AttrBaseTypeConstraint StatusIconPixbufPropertyInfo = StatusIconK type AttrGetType StatusIconPixbufPropertyInfo = GdkPixbuf.Pixbuf type AttrLabel StatusIconPixbufPropertyInfo = "StatusIcon::pixbuf" attrGet _ = getStatusIconPixbuf attrSet _ = setStatusIconPixbuf attrConstruct _ = constructStatusIconPixbuf -- VVV Prop "screen" -- Type: TInterface "Gdk" "Screen" -- Flags: [PropertyReadable,PropertyWritable] getStatusIconScreen :: (MonadIO m, StatusIconK o) => o -> m Gdk.Screen getStatusIconScreen obj = liftIO $ getObjectPropertyObject obj "screen" Gdk.Screen setStatusIconScreen :: (MonadIO m, StatusIconK o, Gdk.ScreenK a) => o -> a -> m () setStatusIconScreen obj val = liftIO $ setObjectPropertyObject obj "screen" val constructStatusIconScreen :: (Gdk.ScreenK a) => a -> IO ([Char], GValue) constructStatusIconScreen val = constructObjectPropertyObject "screen" val data StatusIconScreenPropertyInfo instance AttrInfo StatusIconScreenPropertyInfo where type AttrAllowedOps StatusIconScreenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StatusIconScreenPropertyInfo = Gdk.ScreenK type AttrBaseTypeConstraint StatusIconScreenPropertyInfo = StatusIconK type AttrGetType StatusIconScreenPropertyInfo = Gdk.Screen type AttrLabel StatusIconScreenPropertyInfo = "StatusIcon::screen" attrGet _ = getStatusIconScreen attrSet _ = setStatusIconScreen attrConstruct _ = constructStatusIconScreen -- VVV Prop "size" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getStatusIconSize :: (MonadIO m, StatusIconK o) => o -> m Int32 getStatusIconSize obj = liftIO $ getObjectPropertyCInt obj "size" data StatusIconSizePropertyInfo instance AttrInfo StatusIconSizePropertyInfo where type AttrAllowedOps StatusIconSizePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint StatusIconSizePropertyInfo = (~) () type AttrBaseTypeConstraint StatusIconSizePropertyInfo = StatusIconK type AttrGetType StatusIconSizePropertyInfo = Int32 type AttrLabel StatusIconSizePropertyInfo = "StatusIcon::size" attrGet _ = getStatusIconSize attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "stock" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getStatusIconStock :: (MonadIO m, StatusIconK o) => o -> m T.Text getStatusIconStock obj = liftIO $ getObjectPropertyString obj "stock" setStatusIconStock :: (MonadIO m, StatusIconK o) => o -> T.Text -> m () setStatusIconStock obj val = liftIO $ setObjectPropertyString obj "stock" val constructStatusIconStock :: T.Text -> IO ([Char], GValue) constructStatusIconStock val = constructObjectPropertyString "stock" val data StatusIconStockPropertyInfo instance AttrInfo StatusIconStockPropertyInfo where type AttrAllowedOps StatusIconStockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StatusIconStockPropertyInfo = (~) T.Text type AttrBaseTypeConstraint StatusIconStockPropertyInfo = StatusIconK type AttrGetType StatusIconStockPropertyInfo = T.Text type AttrLabel StatusIconStockPropertyInfo = "StatusIcon::stock" attrGet _ = getStatusIconStock attrSet _ = setStatusIconStock attrConstruct _ = constructStatusIconStock -- VVV Prop "storage-type" -- Type: TInterface "Gtk" "ImageType" -- Flags: [PropertyReadable] getStatusIconStorageType :: (MonadIO m, StatusIconK o) => o -> m ImageType getStatusIconStorageType obj = liftIO $ getObjectPropertyEnum obj "storage-type" data StatusIconStorageTypePropertyInfo instance AttrInfo StatusIconStorageTypePropertyInfo where type AttrAllowedOps StatusIconStorageTypePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint StatusIconStorageTypePropertyInfo = (~) () type AttrBaseTypeConstraint StatusIconStorageTypePropertyInfo = StatusIconK type AttrGetType StatusIconStorageTypePropertyInfo = ImageType type AttrLabel StatusIconStorageTypePropertyInfo = "StatusIcon::storage-type" attrGet _ = getStatusIconStorageType attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "title" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getStatusIconTitle :: (MonadIO m, StatusIconK o) => o -> m T.Text getStatusIconTitle obj = liftIO $ getObjectPropertyString obj "title" setStatusIconTitle :: (MonadIO m, StatusIconK o) => o -> T.Text -> m () setStatusIconTitle obj val = liftIO $ setObjectPropertyString obj "title" val constructStatusIconTitle :: T.Text -> IO ([Char], GValue) constructStatusIconTitle val = constructObjectPropertyString "title" val data StatusIconTitlePropertyInfo instance AttrInfo StatusIconTitlePropertyInfo where type AttrAllowedOps StatusIconTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StatusIconTitlePropertyInfo = (~) T.Text type AttrBaseTypeConstraint StatusIconTitlePropertyInfo = StatusIconK type AttrGetType StatusIconTitlePropertyInfo = T.Text type AttrLabel StatusIconTitlePropertyInfo = "StatusIcon::title" attrGet _ = getStatusIconTitle attrSet _ = setStatusIconTitle attrConstruct _ = constructStatusIconTitle -- VVV Prop "tooltip-markup" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getStatusIconTooltipMarkup :: (MonadIO m, StatusIconK o) => o -> m T.Text getStatusIconTooltipMarkup obj = liftIO $ getObjectPropertyString obj "tooltip-markup" setStatusIconTooltipMarkup :: (MonadIO m, StatusIconK o) => o -> T.Text -> m () setStatusIconTooltipMarkup obj val = liftIO $ setObjectPropertyString obj "tooltip-markup" val constructStatusIconTooltipMarkup :: T.Text -> IO ([Char], GValue) constructStatusIconTooltipMarkup val = constructObjectPropertyString "tooltip-markup" val data StatusIconTooltipMarkupPropertyInfo instance AttrInfo StatusIconTooltipMarkupPropertyInfo where type AttrAllowedOps StatusIconTooltipMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StatusIconTooltipMarkupPropertyInfo = (~) T.Text type AttrBaseTypeConstraint StatusIconTooltipMarkupPropertyInfo = StatusIconK type AttrGetType StatusIconTooltipMarkupPropertyInfo = T.Text type AttrLabel StatusIconTooltipMarkupPropertyInfo = "StatusIcon::tooltip-markup" attrGet _ = getStatusIconTooltipMarkup attrSet _ = setStatusIconTooltipMarkup attrConstruct _ = constructStatusIconTooltipMarkup -- VVV Prop "tooltip-text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getStatusIconTooltipText :: (MonadIO m, StatusIconK o) => o -> m T.Text getStatusIconTooltipText obj = liftIO $ getObjectPropertyString obj "tooltip-text" setStatusIconTooltipText :: (MonadIO m, StatusIconK o) => o -> T.Text -> m () setStatusIconTooltipText obj val = liftIO $ setObjectPropertyString obj "tooltip-text" val constructStatusIconTooltipText :: T.Text -> IO ([Char], GValue) constructStatusIconTooltipText val = constructObjectPropertyString "tooltip-text" val data StatusIconTooltipTextPropertyInfo instance AttrInfo StatusIconTooltipTextPropertyInfo where type AttrAllowedOps StatusIconTooltipTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StatusIconTooltipTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint StatusIconTooltipTextPropertyInfo = StatusIconK type AttrGetType StatusIconTooltipTextPropertyInfo = T.Text type AttrLabel StatusIconTooltipTextPropertyInfo = "StatusIcon::tooltip-text" attrGet _ = getStatusIconTooltipText attrSet _ = setStatusIconTooltipText attrConstruct _ = constructStatusIconTooltipText -- VVV Prop "visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getStatusIconVisible :: (MonadIO m, StatusIconK o) => o -> m Bool getStatusIconVisible obj = liftIO $ getObjectPropertyBool obj "visible" setStatusIconVisible :: (MonadIO m, StatusIconK o) => o -> Bool -> m () setStatusIconVisible obj val = liftIO $ setObjectPropertyBool obj "visible" val constructStatusIconVisible :: Bool -> IO ([Char], GValue) constructStatusIconVisible val = constructObjectPropertyBool "visible" val data StatusIconVisiblePropertyInfo instance AttrInfo StatusIconVisiblePropertyInfo where type AttrAllowedOps StatusIconVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StatusIconVisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint StatusIconVisiblePropertyInfo = StatusIconK type AttrGetType StatusIconVisiblePropertyInfo = Bool type AttrLabel StatusIconVisiblePropertyInfo = "StatusIcon::visible" attrGet _ = getStatusIconVisible attrSet _ = setStatusIconVisible attrConstruct _ = constructStatusIconVisible type instance AttributeList StatusIcon = '[ '("embedded", StatusIconEmbeddedPropertyInfo), '("file", StatusIconFilePropertyInfo), '("gicon", StatusIconGiconPropertyInfo), '("has-tooltip", StatusIconHasTooltipPropertyInfo), '("icon-name", StatusIconIconNamePropertyInfo), '("orientation", StatusIconOrientationPropertyInfo), '("pixbuf", StatusIconPixbufPropertyInfo), '("screen", StatusIconScreenPropertyInfo), '("size", StatusIconSizePropertyInfo), '("stock", StatusIconStockPropertyInfo), '("storage-type", StatusIconStorageTypePropertyInfo), '("title", StatusIconTitlePropertyInfo), '("tooltip-markup", StatusIconTooltipMarkupPropertyInfo), '("tooltip-text", StatusIconTooltipTextPropertyInfo), '("visible", StatusIconVisiblePropertyInfo)] type instance AttributeList Statusbar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList StatusbarAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "context" -- Type: TInterface "Gtk" "StyleContext" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getStyleContext :: (MonadIO m, StyleK o) => o -> m StyleContext getStyleContext obj = liftIO $ getObjectPropertyObject obj "context" StyleContext constructStyleContext :: (StyleContextK a) => a -> IO ([Char], GValue) constructStyleContext val = constructObjectPropertyObject "context" val data StyleContextPropertyInfo instance AttrInfo StyleContextPropertyInfo where type AttrAllowedOps StyleContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StyleContextPropertyInfo = StyleContextK type AttrBaseTypeConstraint StyleContextPropertyInfo = StyleK type AttrGetType StyleContextPropertyInfo = StyleContext type AttrLabel StyleContextPropertyInfo = "Style::context" attrGet _ = getStyleContext attrSet _ = undefined attrConstruct _ = constructStyleContext type instance AttributeList Style = '[ '("context", StyleContextPropertyInfo)] -- VVV Prop "direction" -- Type: TInterface "Gtk" "TextDirection" -- Flags: [PropertyReadable,PropertyWritable] getStyleContextDirection :: (MonadIO m, StyleContextK o) => o -> m TextDirection getStyleContextDirection obj = liftIO $ getObjectPropertyEnum obj "direction" setStyleContextDirection :: (MonadIO m, StyleContextK o) => o -> TextDirection -> m () setStyleContextDirection obj val = liftIO $ setObjectPropertyEnum obj "direction" val constructStyleContextDirection :: TextDirection -> IO ([Char], GValue) constructStyleContextDirection val = constructObjectPropertyEnum "direction" val data StyleContextDirectionPropertyInfo instance AttrInfo StyleContextDirectionPropertyInfo where type AttrAllowedOps StyleContextDirectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StyleContextDirectionPropertyInfo = (~) TextDirection type AttrBaseTypeConstraint StyleContextDirectionPropertyInfo = StyleContextK type AttrGetType StyleContextDirectionPropertyInfo = TextDirection type AttrLabel StyleContextDirectionPropertyInfo = "StyleContext::direction" attrGet _ = getStyleContextDirection attrSet _ = setStyleContextDirection attrConstruct _ = constructStyleContextDirection -- VVV Prop "paint-clock" -- Type: TInterface "Gdk" "FrameClock" -- Flags: [PropertyReadable,PropertyWritable] getStyleContextPaintClock :: (MonadIO m, StyleContextK o) => o -> m Gdk.FrameClock getStyleContextPaintClock obj = liftIO $ getObjectPropertyObject obj "paint-clock" Gdk.FrameClock setStyleContextPaintClock :: (MonadIO m, StyleContextK o, Gdk.FrameClockK a) => o -> a -> m () setStyleContextPaintClock obj val = liftIO $ setObjectPropertyObject obj "paint-clock" val constructStyleContextPaintClock :: (Gdk.FrameClockK a) => a -> IO ([Char], GValue) constructStyleContextPaintClock val = constructObjectPropertyObject "paint-clock" val data StyleContextPaintClockPropertyInfo instance AttrInfo StyleContextPaintClockPropertyInfo where type AttrAllowedOps StyleContextPaintClockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StyleContextPaintClockPropertyInfo = Gdk.FrameClockK type AttrBaseTypeConstraint StyleContextPaintClockPropertyInfo = StyleContextK type AttrGetType StyleContextPaintClockPropertyInfo = Gdk.FrameClock type AttrLabel StyleContextPaintClockPropertyInfo = "StyleContext::paint-clock" attrGet _ = getStyleContextPaintClock attrSet _ = setStyleContextPaintClock attrConstruct _ = constructStyleContextPaintClock -- VVV Prop "parent" -- Type: TInterface "Gtk" "StyleContext" -- Flags: [PropertyReadable,PropertyWritable] getStyleContextParent :: (MonadIO m, StyleContextK o) => o -> m StyleContext getStyleContextParent obj = liftIO $ getObjectPropertyObject obj "parent" StyleContext setStyleContextParent :: (MonadIO m, StyleContextK o, StyleContextK a) => o -> a -> m () setStyleContextParent obj val = liftIO $ setObjectPropertyObject obj "parent" val constructStyleContextParent :: (StyleContextK a) => a -> IO ([Char], GValue) constructStyleContextParent val = constructObjectPropertyObject "parent" val data StyleContextParentPropertyInfo instance AttrInfo StyleContextParentPropertyInfo where type AttrAllowedOps StyleContextParentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StyleContextParentPropertyInfo = StyleContextK type AttrBaseTypeConstraint StyleContextParentPropertyInfo = StyleContextK type AttrGetType StyleContextParentPropertyInfo = StyleContext type AttrLabel StyleContextParentPropertyInfo = "StyleContext::parent" attrGet _ = getStyleContextParent attrSet _ = setStyleContextParent attrConstruct _ = constructStyleContextParent -- VVV Prop "screen" -- Type: TInterface "Gdk" "Screen" -- Flags: [PropertyReadable,PropertyWritable] getStyleContextScreen :: (MonadIO m, StyleContextK o) => o -> m Gdk.Screen getStyleContextScreen obj = liftIO $ getObjectPropertyObject obj "screen" Gdk.Screen setStyleContextScreen :: (MonadIO m, StyleContextK o, Gdk.ScreenK a) => o -> a -> m () setStyleContextScreen obj val = liftIO $ setObjectPropertyObject obj "screen" val constructStyleContextScreen :: (Gdk.ScreenK a) => a -> IO ([Char], GValue) constructStyleContextScreen val = constructObjectPropertyObject "screen" val data StyleContextScreenPropertyInfo instance AttrInfo StyleContextScreenPropertyInfo where type AttrAllowedOps StyleContextScreenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint StyleContextScreenPropertyInfo = Gdk.ScreenK type AttrBaseTypeConstraint StyleContextScreenPropertyInfo = StyleContextK type AttrGetType StyleContextScreenPropertyInfo = Gdk.Screen type AttrLabel StyleContextScreenPropertyInfo = "StyleContext::screen" attrGet _ = getStyleContextScreen attrSet _ = setStyleContextScreen attrConstruct _ = constructStyleContextScreen type instance AttributeList StyleContext = '[ '("direction", StyleContextDirectionPropertyInfo), '("paint-clock", StyleContextPaintClockPropertyInfo), '("parent", StyleContextParentPropertyInfo), '("screen", StyleContextScreenPropertyInfo)] type instance AttributeList StyleProperties = '[ ] type instance AttributeList StyleProvider = '[ ] -- VVV Prop "active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSwitchActive :: (MonadIO m, SwitchK o) => o -> m Bool getSwitchActive obj = liftIO $ getObjectPropertyBool obj "active" setSwitchActive :: (MonadIO m, SwitchK o) => o -> Bool -> m () setSwitchActive obj val = liftIO $ setObjectPropertyBool obj "active" val constructSwitchActive :: Bool -> IO ([Char], GValue) constructSwitchActive val = constructObjectPropertyBool "active" val data SwitchActivePropertyInfo instance AttrInfo SwitchActivePropertyInfo where type AttrAllowedOps SwitchActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SwitchActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint SwitchActivePropertyInfo = SwitchK type AttrGetType SwitchActivePropertyInfo = Bool type AttrLabel SwitchActivePropertyInfo = "Switch::active" attrGet _ = getSwitchActive attrSet _ = setSwitchActive attrConstruct _ = constructSwitchActive -- VVV Prop "state" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSwitchState :: (MonadIO m, SwitchK o) => o -> m Bool getSwitchState obj = liftIO $ getObjectPropertyBool obj "state" setSwitchState :: (MonadIO m, SwitchK o) => o -> Bool -> m () setSwitchState obj val = liftIO $ setObjectPropertyBool obj "state" val constructSwitchState :: Bool -> IO ([Char], GValue) constructSwitchState val = constructObjectPropertyBool "state" val data SwitchStatePropertyInfo instance AttrInfo SwitchStatePropertyInfo where type AttrAllowedOps SwitchStatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SwitchStatePropertyInfo = (~) Bool type AttrBaseTypeConstraint SwitchStatePropertyInfo = SwitchK type AttrGetType SwitchStatePropertyInfo = Bool type AttrLabel SwitchStatePropertyInfo = "Switch::state" attrGet _ = getSwitchState attrSet _ = setSwitchState attrConstruct _ = constructSwitchState type instance AttributeList Switch = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("active", SwitchActivePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("state", SwitchStatePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList SwitchAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "column-spacing" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getTableColumnSpacing :: (MonadIO m, TableK o) => o -> m Word32 getTableColumnSpacing obj = liftIO $ getObjectPropertyCUInt obj "column-spacing" setTableColumnSpacing :: (MonadIO m, TableK o) => o -> Word32 -> m () setTableColumnSpacing obj val = liftIO $ setObjectPropertyCUInt obj "column-spacing" val constructTableColumnSpacing :: Word32 -> IO ([Char], GValue) constructTableColumnSpacing val = constructObjectPropertyCUInt "column-spacing" val data TableColumnSpacingPropertyInfo instance AttrInfo TableColumnSpacingPropertyInfo where type AttrAllowedOps TableColumnSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TableColumnSpacingPropertyInfo = (~) Word32 type AttrBaseTypeConstraint TableColumnSpacingPropertyInfo = TableK type AttrGetType TableColumnSpacingPropertyInfo = Word32 type AttrLabel TableColumnSpacingPropertyInfo = "Table::column-spacing" attrGet _ = getTableColumnSpacing attrSet _ = setTableColumnSpacing attrConstruct _ = constructTableColumnSpacing -- VVV Prop "homogeneous" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTableHomogeneous :: (MonadIO m, TableK o) => o -> m Bool getTableHomogeneous obj = liftIO $ getObjectPropertyBool obj "homogeneous" setTableHomogeneous :: (MonadIO m, TableK o) => o -> Bool -> m () setTableHomogeneous obj val = liftIO $ setObjectPropertyBool obj "homogeneous" val constructTableHomogeneous :: Bool -> IO ([Char], GValue) constructTableHomogeneous val = constructObjectPropertyBool "homogeneous" val data TableHomogeneousPropertyInfo instance AttrInfo TableHomogeneousPropertyInfo where type AttrAllowedOps TableHomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TableHomogeneousPropertyInfo = (~) Bool type AttrBaseTypeConstraint TableHomogeneousPropertyInfo = TableK type AttrGetType TableHomogeneousPropertyInfo = Bool type AttrLabel TableHomogeneousPropertyInfo = "Table::homogeneous" attrGet _ = getTableHomogeneous attrSet _ = setTableHomogeneous attrConstruct _ = constructTableHomogeneous -- VVV Prop "n-columns" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getTableNColumns :: (MonadIO m, TableK o) => o -> m Word32 getTableNColumns obj = liftIO $ getObjectPropertyCUInt obj "n-columns" setTableNColumns :: (MonadIO m, TableK o) => o -> Word32 -> m () setTableNColumns obj val = liftIO $ setObjectPropertyCUInt obj "n-columns" val constructTableNColumns :: Word32 -> IO ([Char], GValue) constructTableNColumns val = constructObjectPropertyCUInt "n-columns" val data TableNColumnsPropertyInfo instance AttrInfo TableNColumnsPropertyInfo where type AttrAllowedOps TableNColumnsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TableNColumnsPropertyInfo = (~) Word32 type AttrBaseTypeConstraint TableNColumnsPropertyInfo = TableK type AttrGetType TableNColumnsPropertyInfo = Word32 type AttrLabel TableNColumnsPropertyInfo = "Table::n-columns" attrGet _ = getTableNColumns attrSet _ = setTableNColumns attrConstruct _ = constructTableNColumns -- VVV Prop "n-rows" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getTableNRows :: (MonadIO m, TableK o) => o -> m Word32 getTableNRows obj = liftIO $ getObjectPropertyCUInt obj "n-rows" setTableNRows :: (MonadIO m, TableK o) => o -> Word32 -> m () setTableNRows obj val = liftIO $ setObjectPropertyCUInt obj "n-rows" val constructTableNRows :: Word32 -> IO ([Char], GValue) constructTableNRows val = constructObjectPropertyCUInt "n-rows" val data TableNRowsPropertyInfo instance AttrInfo TableNRowsPropertyInfo where type AttrAllowedOps TableNRowsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TableNRowsPropertyInfo = (~) Word32 type AttrBaseTypeConstraint TableNRowsPropertyInfo = TableK type AttrGetType TableNRowsPropertyInfo = Word32 type AttrLabel TableNRowsPropertyInfo = "Table::n-rows" attrGet _ = getTableNRows attrSet _ = setTableNRows attrConstruct _ = constructTableNRows -- VVV Prop "row-spacing" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getTableRowSpacing :: (MonadIO m, TableK o) => o -> m Word32 getTableRowSpacing obj = liftIO $ getObjectPropertyCUInt obj "row-spacing" setTableRowSpacing :: (MonadIO m, TableK o) => o -> Word32 -> m () setTableRowSpacing obj val = liftIO $ setObjectPropertyCUInt obj "row-spacing" val constructTableRowSpacing :: Word32 -> IO ([Char], GValue) constructTableRowSpacing val = constructObjectPropertyCUInt "row-spacing" val data TableRowSpacingPropertyInfo instance AttrInfo TableRowSpacingPropertyInfo where type AttrAllowedOps TableRowSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TableRowSpacingPropertyInfo = (~) Word32 type AttrBaseTypeConstraint TableRowSpacingPropertyInfo = TableK type AttrGetType TableRowSpacingPropertyInfo = Word32 type AttrLabel TableRowSpacingPropertyInfo = "Table::row-spacing" attrGet _ = getTableRowSpacing attrSet _ = setTableRowSpacing attrConstruct _ = constructTableRowSpacing type instance AttributeList Table = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("column-spacing", TableColumnSpacingPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", TableHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("n-columns", TableNColumnsPropertyInfo), '("n-rows", TableNRowsPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("row-spacing", TableRowSpacingPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList TearoffMenuItem = '[ '("accel-path", MenuItemAccelPathPropertyInfo), '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", MenuItemLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("right-justified", MenuItemRightJustifiedPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("submenu", MenuItemSubmenuPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-underline", MenuItemUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "copy-target-list" -- Type: TInterface "Gtk" "TargetList" -- Flags: [PropertyReadable] getTextBufferCopyTargetList :: (MonadIO m, TextBufferK o) => o -> m TargetList getTextBufferCopyTargetList obj = liftIO $ getObjectPropertyBoxed obj "copy-target-list" TargetList data TextBufferCopyTargetListPropertyInfo instance AttrInfo TextBufferCopyTargetListPropertyInfo where type AttrAllowedOps TextBufferCopyTargetListPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint TextBufferCopyTargetListPropertyInfo = (~) () type AttrBaseTypeConstraint TextBufferCopyTargetListPropertyInfo = TextBufferK type AttrGetType TextBufferCopyTargetListPropertyInfo = TargetList type AttrLabel TextBufferCopyTargetListPropertyInfo = "TextBuffer::copy-target-list" attrGet _ = getTextBufferCopyTargetList attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "cursor-position" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getTextBufferCursorPosition :: (MonadIO m, TextBufferK o) => o -> m Int32 getTextBufferCursorPosition obj = liftIO $ getObjectPropertyCInt obj "cursor-position" data TextBufferCursorPositionPropertyInfo instance AttrInfo TextBufferCursorPositionPropertyInfo where type AttrAllowedOps TextBufferCursorPositionPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint TextBufferCursorPositionPropertyInfo = (~) () type AttrBaseTypeConstraint TextBufferCursorPositionPropertyInfo = TextBufferK type AttrGetType TextBufferCursorPositionPropertyInfo = Int32 type AttrLabel TextBufferCursorPositionPropertyInfo = "TextBuffer::cursor-position" attrGet _ = getTextBufferCursorPosition attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "has-selection" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getTextBufferHasSelection :: (MonadIO m, TextBufferK o) => o -> m Bool getTextBufferHasSelection obj = liftIO $ getObjectPropertyBool obj "has-selection" data TextBufferHasSelectionPropertyInfo instance AttrInfo TextBufferHasSelectionPropertyInfo where type AttrAllowedOps TextBufferHasSelectionPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint TextBufferHasSelectionPropertyInfo = (~) () type AttrBaseTypeConstraint TextBufferHasSelectionPropertyInfo = TextBufferK type AttrGetType TextBufferHasSelectionPropertyInfo = Bool type AttrLabel TextBufferHasSelectionPropertyInfo = "TextBuffer::has-selection" attrGet _ = getTextBufferHasSelection attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "paste-target-list" -- Type: TInterface "Gtk" "TargetList" -- Flags: [PropertyReadable] getTextBufferPasteTargetList :: (MonadIO m, TextBufferK o) => o -> m TargetList getTextBufferPasteTargetList obj = liftIO $ getObjectPropertyBoxed obj "paste-target-list" TargetList data TextBufferPasteTargetListPropertyInfo instance AttrInfo TextBufferPasteTargetListPropertyInfo where type AttrAllowedOps TextBufferPasteTargetListPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint TextBufferPasteTargetListPropertyInfo = (~) () type AttrBaseTypeConstraint TextBufferPasteTargetListPropertyInfo = TextBufferK type AttrGetType TextBufferPasteTargetListPropertyInfo = TargetList type AttrLabel TextBufferPasteTargetListPropertyInfo = "TextBuffer::paste-target-list" attrGet _ = getTextBufferPasteTargetList attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "tag-table" -- Type: TInterface "Gtk" "TextTagTable" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTextBufferTagTable :: (MonadIO m, TextBufferK o) => o -> m TextTagTable getTextBufferTagTable obj = liftIO $ getObjectPropertyObject obj "tag-table" TextTagTable constructTextBufferTagTable :: (TextTagTableK a) => a -> IO ([Char], GValue) constructTextBufferTagTable val = constructObjectPropertyObject "tag-table" val data TextBufferTagTablePropertyInfo instance AttrInfo TextBufferTagTablePropertyInfo where type AttrAllowedOps TextBufferTagTablePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextBufferTagTablePropertyInfo = TextTagTableK type AttrBaseTypeConstraint TextBufferTagTablePropertyInfo = TextBufferK type AttrGetType TextBufferTagTablePropertyInfo = TextTagTable type AttrLabel TextBufferTagTablePropertyInfo = "TextBuffer::tag-table" attrGet _ = getTextBufferTagTable attrSet _ = undefined attrConstruct _ = constructTextBufferTagTable -- VVV Prop "text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getTextBufferText :: (MonadIO m, TextBufferK o) => o -> m T.Text getTextBufferText obj = liftIO $ getObjectPropertyString obj "text" setTextBufferText :: (MonadIO m, TextBufferK o) => o -> T.Text -> m () setTextBufferText obj val = liftIO $ setObjectPropertyString obj "text" val constructTextBufferText :: T.Text -> IO ([Char], GValue) constructTextBufferText val = constructObjectPropertyString "text" val data TextBufferTextPropertyInfo instance AttrInfo TextBufferTextPropertyInfo where type AttrAllowedOps TextBufferTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextBufferTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextBufferTextPropertyInfo = TextBufferK type AttrGetType TextBufferTextPropertyInfo = T.Text type AttrLabel TextBufferTextPropertyInfo = "TextBuffer::text" attrGet _ = getTextBufferText attrSet _ = setTextBufferText attrConstruct _ = constructTextBufferText type instance AttributeList TextBuffer = '[ '("copy-target-list", TextBufferCopyTargetListPropertyInfo), '("cursor-position", TextBufferCursorPositionPropertyInfo), '("has-selection", TextBufferHasSelectionPropertyInfo), '("paste-target-list", TextBufferPasteTargetListPropertyInfo), '("tag-table", TextBufferTagTablePropertyInfo), '("text", TextBufferTextPropertyInfo)] type instance AttributeList TextCellAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("renderer", RendererCellAccessibleRendererPropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList TextChildAnchor = '[ ] -- VVV Prop "left-gravity" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTextMarkLeftGravity :: (MonadIO m, TextMarkK o) => o -> m Bool getTextMarkLeftGravity obj = liftIO $ getObjectPropertyBool obj "left-gravity" constructTextMarkLeftGravity :: Bool -> IO ([Char], GValue) constructTextMarkLeftGravity val = constructObjectPropertyBool "left-gravity" val data TextMarkLeftGravityPropertyInfo instance AttrInfo TextMarkLeftGravityPropertyInfo where type AttrAllowedOps TextMarkLeftGravityPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextMarkLeftGravityPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextMarkLeftGravityPropertyInfo = TextMarkK type AttrGetType TextMarkLeftGravityPropertyInfo = Bool type AttrLabel TextMarkLeftGravityPropertyInfo = "TextMark::left-gravity" attrGet _ = getTextMarkLeftGravity attrSet _ = undefined attrConstruct _ = constructTextMarkLeftGravity -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTextMarkName :: (MonadIO m, TextMarkK o) => o -> m T.Text getTextMarkName obj = liftIO $ getObjectPropertyString obj "name" constructTextMarkName :: T.Text -> IO ([Char], GValue) constructTextMarkName val = constructObjectPropertyString "name" val data TextMarkNamePropertyInfo instance AttrInfo TextMarkNamePropertyInfo where type AttrAllowedOps TextMarkNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextMarkNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextMarkNamePropertyInfo = TextMarkK type AttrGetType TextMarkNamePropertyInfo = T.Text type AttrLabel TextMarkNamePropertyInfo = "TextMark::name" attrGet _ = getTextMarkName attrSet _ = undefined attrConstruct _ = constructTextMarkName type instance AttributeList TextMark = '[ '("left-gravity", TextMarkLeftGravityPropertyInfo), '("name", TextMarkNamePropertyInfo)] -- VVV Prop "accumulative-margin" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagAccumulativeMargin :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagAccumulativeMargin obj = liftIO $ getObjectPropertyBool obj "accumulative-margin" setTextTagAccumulativeMargin :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagAccumulativeMargin obj val = liftIO $ setObjectPropertyBool obj "accumulative-margin" val constructTextTagAccumulativeMargin :: Bool -> IO ([Char], GValue) constructTextTagAccumulativeMargin val = constructObjectPropertyBool "accumulative-margin" val data TextTagAccumulativeMarginPropertyInfo instance AttrInfo TextTagAccumulativeMarginPropertyInfo where type AttrAllowedOps TextTagAccumulativeMarginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagAccumulativeMarginPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagAccumulativeMarginPropertyInfo = TextTagK type AttrGetType TextTagAccumulativeMarginPropertyInfo = Bool type AttrLabel TextTagAccumulativeMarginPropertyInfo = "TextTag::accumulative-margin" attrGet _ = getTextTagAccumulativeMargin attrSet _ = setTextTagAccumulativeMargin attrConstruct _ = constructTextTagAccumulativeMargin -- VVV Prop "background" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setTextTagBackground :: (MonadIO m, TextTagK o) => o -> T.Text -> m () setTextTagBackground obj val = liftIO $ setObjectPropertyString obj "background" val constructTextTagBackground :: T.Text -> IO ([Char], GValue) constructTextTagBackground val = constructObjectPropertyString "background" val data TextTagBackgroundPropertyInfo instance AttrInfo TextTagBackgroundPropertyInfo where type AttrAllowedOps TextTagBackgroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint TextTagBackgroundPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextTagBackgroundPropertyInfo = TextTagK type AttrGetType TextTagBackgroundPropertyInfo = () type AttrLabel TextTagBackgroundPropertyInfo = "TextTag::background" attrGet _ = undefined attrSet _ = setTextTagBackground attrConstruct _ = constructTextTagBackground -- VVV Prop "background-full-height" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagBackgroundFullHeight :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagBackgroundFullHeight obj = liftIO $ getObjectPropertyBool obj "background-full-height" setTextTagBackgroundFullHeight :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagBackgroundFullHeight obj val = liftIO $ setObjectPropertyBool obj "background-full-height" val constructTextTagBackgroundFullHeight :: Bool -> IO ([Char], GValue) constructTextTagBackgroundFullHeight val = constructObjectPropertyBool "background-full-height" val data TextTagBackgroundFullHeightPropertyInfo instance AttrInfo TextTagBackgroundFullHeightPropertyInfo where type AttrAllowedOps TextTagBackgroundFullHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagBackgroundFullHeightPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagBackgroundFullHeightPropertyInfo = TextTagK type AttrGetType TextTagBackgroundFullHeightPropertyInfo = Bool type AttrLabel TextTagBackgroundFullHeightPropertyInfo = "TextTag::background-full-height" attrGet _ = getTextTagBackgroundFullHeight attrSet _ = setTextTagBackgroundFullHeight attrConstruct _ = constructTextTagBackgroundFullHeight -- VVV Prop "background-full-height-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagBackgroundFullHeightSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagBackgroundFullHeightSet obj = liftIO $ getObjectPropertyBool obj "background-full-height-set" setTextTagBackgroundFullHeightSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagBackgroundFullHeightSet obj val = liftIO $ setObjectPropertyBool obj "background-full-height-set" val constructTextTagBackgroundFullHeightSet :: Bool -> IO ([Char], GValue) constructTextTagBackgroundFullHeightSet val = constructObjectPropertyBool "background-full-height-set" val data TextTagBackgroundFullHeightSetPropertyInfo instance AttrInfo TextTagBackgroundFullHeightSetPropertyInfo where type AttrAllowedOps TextTagBackgroundFullHeightSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagBackgroundFullHeightSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagBackgroundFullHeightSetPropertyInfo = TextTagK type AttrGetType TextTagBackgroundFullHeightSetPropertyInfo = Bool type AttrLabel TextTagBackgroundFullHeightSetPropertyInfo = "TextTag::background-full-height-set" attrGet _ = getTextTagBackgroundFullHeightSet attrSet _ = setTextTagBackgroundFullHeightSet attrConstruct _ = constructTextTagBackgroundFullHeightSet -- VVV Prop "background-gdk" -- Type: TInterface "Gdk" "Color" -- Flags: [PropertyReadable,PropertyWritable] getTextTagBackgroundGdk :: (MonadIO m, TextTagK o) => o -> m Gdk.Color getTextTagBackgroundGdk obj = liftIO $ getObjectPropertyBoxed obj "background-gdk" Gdk.Color setTextTagBackgroundGdk :: (MonadIO m, TextTagK o) => o -> Gdk.Color -> m () setTextTagBackgroundGdk obj val = liftIO $ setObjectPropertyBoxed obj "background-gdk" val constructTextTagBackgroundGdk :: Gdk.Color -> IO ([Char], GValue) constructTextTagBackgroundGdk val = constructObjectPropertyBoxed "background-gdk" val data TextTagBackgroundGdkPropertyInfo instance AttrInfo TextTagBackgroundGdkPropertyInfo where type AttrAllowedOps TextTagBackgroundGdkPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagBackgroundGdkPropertyInfo = (~) Gdk.Color type AttrBaseTypeConstraint TextTagBackgroundGdkPropertyInfo = TextTagK type AttrGetType TextTagBackgroundGdkPropertyInfo = Gdk.Color type AttrLabel TextTagBackgroundGdkPropertyInfo = "TextTag::background-gdk" attrGet _ = getTextTagBackgroundGdk attrSet _ = setTextTagBackgroundGdk attrConstruct _ = constructTextTagBackgroundGdk -- VVV Prop "background-rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getTextTagBackgroundRgba :: (MonadIO m, TextTagK o) => o -> m Gdk.RGBA getTextTagBackgroundRgba obj = liftIO $ getObjectPropertyBoxed obj "background-rgba" Gdk.RGBA setTextTagBackgroundRgba :: (MonadIO m, TextTagK o) => o -> Gdk.RGBA -> m () setTextTagBackgroundRgba obj val = liftIO $ setObjectPropertyBoxed obj "background-rgba" val constructTextTagBackgroundRgba :: Gdk.RGBA -> IO ([Char], GValue) constructTextTagBackgroundRgba val = constructObjectPropertyBoxed "background-rgba" val data TextTagBackgroundRgbaPropertyInfo instance AttrInfo TextTagBackgroundRgbaPropertyInfo where type AttrAllowedOps TextTagBackgroundRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagBackgroundRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint TextTagBackgroundRgbaPropertyInfo = TextTagK type AttrGetType TextTagBackgroundRgbaPropertyInfo = Gdk.RGBA type AttrLabel TextTagBackgroundRgbaPropertyInfo = "TextTag::background-rgba" attrGet _ = getTextTagBackgroundRgba attrSet _ = setTextTagBackgroundRgba attrConstruct _ = constructTextTagBackgroundRgba -- VVV Prop "background-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagBackgroundSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagBackgroundSet obj = liftIO $ getObjectPropertyBool obj "background-set" setTextTagBackgroundSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagBackgroundSet obj val = liftIO $ setObjectPropertyBool obj "background-set" val constructTextTagBackgroundSet :: Bool -> IO ([Char], GValue) constructTextTagBackgroundSet val = constructObjectPropertyBool "background-set" val data TextTagBackgroundSetPropertyInfo instance AttrInfo TextTagBackgroundSetPropertyInfo where type AttrAllowedOps TextTagBackgroundSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagBackgroundSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagBackgroundSetPropertyInfo = TextTagK type AttrGetType TextTagBackgroundSetPropertyInfo = Bool type AttrLabel TextTagBackgroundSetPropertyInfo = "TextTag::background-set" attrGet _ = getTextTagBackgroundSet attrSet _ = setTextTagBackgroundSet attrConstruct _ = constructTextTagBackgroundSet -- VVV Prop "direction" -- Type: TInterface "Gtk" "TextDirection" -- Flags: [PropertyReadable,PropertyWritable] getTextTagDirection :: (MonadIO m, TextTagK o) => o -> m TextDirection getTextTagDirection obj = liftIO $ getObjectPropertyEnum obj "direction" setTextTagDirection :: (MonadIO m, TextTagK o) => o -> TextDirection -> m () setTextTagDirection obj val = liftIO $ setObjectPropertyEnum obj "direction" val constructTextTagDirection :: TextDirection -> IO ([Char], GValue) constructTextTagDirection val = constructObjectPropertyEnum "direction" val data TextTagDirectionPropertyInfo instance AttrInfo TextTagDirectionPropertyInfo where type AttrAllowedOps TextTagDirectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagDirectionPropertyInfo = (~) TextDirection type AttrBaseTypeConstraint TextTagDirectionPropertyInfo = TextTagK type AttrGetType TextTagDirectionPropertyInfo = TextDirection type AttrLabel TextTagDirectionPropertyInfo = "TextTag::direction" attrGet _ = getTextTagDirection attrSet _ = setTextTagDirection attrConstruct _ = constructTextTagDirection -- VVV Prop "editable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagEditable :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagEditable obj = liftIO $ getObjectPropertyBool obj "editable" setTextTagEditable :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagEditable obj val = liftIO $ setObjectPropertyBool obj "editable" val constructTextTagEditable :: Bool -> IO ([Char], GValue) constructTextTagEditable val = constructObjectPropertyBool "editable" val data TextTagEditablePropertyInfo instance AttrInfo TextTagEditablePropertyInfo where type AttrAllowedOps TextTagEditablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagEditablePropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagEditablePropertyInfo = TextTagK type AttrGetType TextTagEditablePropertyInfo = Bool type AttrLabel TextTagEditablePropertyInfo = "TextTag::editable" attrGet _ = getTextTagEditable attrSet _ = setTextTagEditable attrConstruct _ = constructTextTagEditable -- VVV Prop "editable-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagEditableSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagEditableSet obj = liftIO $ getObjectPropertyBool obj "editable-set" setTextTagEditableSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagEditableSet obj val = liftIO $ setObjectPropertyBool obj "editable-set" val constructTextTagEditableSet :: Bool -> IO ([Char], GValue) constructTextTagEditableSet val = constructObjectPropertyBool "editable-set" val data TextTagEditableSetPropertyInfo instance AttrInfo TextTagEditableSetPropertyInfo where type AttrAllowedOps TextTagEditableSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagEditableSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagEditableSetPropertyInfo = TextTagK type AttrGetType TextTagEditableSetPropertyInfo = Bool type AttrLabel TextTagEditableSetPropertyInfo = "TextTag::editable-set" attrGet _ = getTextTagEditableSet attrSet _ = setTextTagEditableSet attrConstruct _ = constructTextTagEditableSet -- VVV Prop "fallback" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagFallback :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagFallback obj = liftIO $ getObjectPropertyBool obj "fallback" setTextTagFallback :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagFallback obj val = liftIO $ setObjectPropertyBool obj "fallback" val constructTextTagFallback :: Bool -> IO ([Char], GValue) constructTextTagFallback val = constructObjectPropertyBool "fallback" val data TextTagFallbackPropertyInfo instance AttrInfo TextTagFallbackPropertyInfo where type AttrAllowedOps TextTagFallbackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagFallbackPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagFallbackPropertyInfo = TextTagK type AttrGetType TextTagFallbackPropertyInfo = Bool type AttrLabel TextTagFallbackPropertyInfo = "TextTag::fallback" attrGet _ = getTextTagFallback attrSet _ = setTextTagFallback attrConstruct _ = constructTextTagFallback -- VVV Prop "fallback-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagFallbackSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagFallbackSet obj = liftIO $ getObjectPropertyBool obj "fallback-set" setTextTagFallbackSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagFallbackSet obj val = liftIO $ setObjectPropertyBool obj "fallback-set" val constructTextTagFallbackSet :: Bool -> IO ([Char], GValue) constructTextTagFallbackSet val = constructObjectPropertyBool "fallback-set" val data TextTagFallbackSetPropertyInfo instance AttrInfo TextTagFallbackSetPropertyInfo where type AttrAllowedOps TextTagFallbackSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagFallbackSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagFallbackSetPropertyInfo = TextTagK type AttrGetType TextTagFallbackSetPropertyInfo = Bool type AttrLabel TextTagFallbackSetPropertyInfo = "TextTag::fallback-set" attrGet _ = getTextTagFallbackSet attrSet _ = setTextTagFallbackSet attrConstruct _ = constructTextTagFallbackSet -- VVV Prop "family" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getTextTagFamily :: (MonadIO m, TextTagK o) => o -> m T.Text getTextTagFamily obj = liftIO $ getObjectPropertyString obj "family" setTextTagFamily :: (MonadIO m, TextTagK o) => o -> T.Text -> m () setTextTagFamily obj val = liftIO $ setObjectPropertyString obj "family" val constructTextTagFamily :: T.Text -> IO ([Char], GValue) constructTextTagFamily val = constructObjectPropertyString "family" val data TextTagFamilyPropertyInfo instance AttrInfo TextTagFamilyPropertyInfo where type AttrAllowedOps TextTagFamilyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagFamilyPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextTagFamilyPropertyInfo = TextTagK type AttrGetType TextTagFamilyPropertyInfo = T.Text type AttrLabel TextTagFamilyPropertyInfo = "TextTag::family" attrGet _ = getTextTagFamily attrSet _ = setTextTagFamily attrConstruct _ = constructTextTagFamily -- VVV Prop "family-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagFamilySet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagFamilySet obj = liftIO $ getObjectPropertyBool obj "family-set" setTextTagFamilySet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagFamilySet obj val = liftIO $ setObjectPropertyBool obj "family-set" val constructTextTagFamilySet :: Bool -> IO ([Char], GValue) constructTextTagFamilySet val = constructObjectPropertyBool "family-set" val data TextTagFamilySetPropertyInfo instance AttrInfo TextTagFamilySetPropertyInfo where type AttrAllowedOps TextTagFamilySetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagFamilySetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagFamilySetPropertyInfo = TextTagK type AttrGetType TextTagFamilySetPropertyInfo = Bool type AttrLabel TextTagFamilySetPropertyInfo = "TextTag::family-set" attrGet _ = getTextTagFamilySet attrSet _ = setTextTagFamilySet attrConstruct _ = constructTextTagFamilySet -- VVV Prop "font" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getTextTagFont :: (MonadIO m, TextTagK o) => o -> m T.Text getTextTagFont obj = liftIO $ getObjectPropertyString obj "font" setTextTagFont :: (MonadIO m, TextTagK o) => o -> T.Text -> m () setTextTagFont obj val = liftIO $ setObjectPropertyString obj "font" val constructTextTagFont :: T.Text -> IO ([Char], GValue) constructTextTagFont val = constructObjectPropertyString "font" val data TextTagFontPropertyInfo instance AttrInfo TextTagFontPropertyInfo where type AttrAllowedOps TextTagFontPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagFontPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextTagFontPropertyInfo = TextTagK type AttrGetType TextTagFontPropertyInfo = T.Text type AttrLabel TextTagFontPropertyInfo = "TextTag::font" attrGet _ = getTextTagFont attrSet _ = setTextTagFont attrConstruct _ = constructTextTagFont -- VVV Prop "font-desc" -- Type: TInterface "Pango" "FontDescription" -- Flags: [PropertyReadable,PropertyWritable] getTextTagFontDesc :: (MonadIO m, TextTagK o) => o -> m Pango.FontDescription getTextTagFontDesc obj = liftIO $ getObjectPropertyBoxed obj "font-desc" Pango.FontDescription setTextTagFontDesc :: (MonadIO m, TextTagK o) => o -> Pango.FontDescription -> m () setTextTagFontDesc obj val = liftIO $ setObjectPropertyBoxed obj "font-desc" val constructTextTagFontDesc :: Pango.FontDescription -> IO ([Char], GValue) constructTextTagFontDesc val = constructObjectPropertyBoxed "font-desc" val data TextTagFontDescPropertyInfo instance AttrInfo TextTagFontDescPropertyInfo where type AttrAllowedOps TextTagFontDescPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagFontDescPropertyInfo = (~) Pango.FontDescription type AttrBaseTypeConstraint TextTagFontDescPropertyInfo = TextTagK type AttrGetType TextTagFontDescPropertyInfo = Pango.FontDescription type AttrLabel TextTagFontDescPropertyInfo = "TextTag::font-desc" attrGet _ = getTextTagFontDesc attrSet _ = setTextTagFontDesc attrConstruct _ = constructTextTagFontDesc -- VVV Prop "font-features" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getTextTagFontFeatures :: (MonadIO m, TextTagK o) => o -> m T.Text getTextTagFontFeatures obj = liftIO $ getObjectPropertyString obj "font-features" setTextTagFontFeatures :: (MonadIO m, TextTagK o) => o -> T.Text -> m () setTextTagFontFeatures obj val = liftIO $ setObjectPropertyString obj "font-features" val constructTextTagFontFeatures :: T.Text -> IO ([Char], GValue) constructTextTagFontFeatures val = constructObjectPropertyString "font-features" val data TextTagFontFeaturesPropertyInfo instance AttrInfo TextTagFontFeaturesPropertyInfo where type AttrAllowedOps TextTagFontFeaturesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagFontFeaturesPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextTagFontFeaturesPropertyInfo = TextTagK type AttrGetType TextTagFontFeaturesPropertyInfo = T.Text type AttrLabel TextTagFontFeaturesPropertyInfo = "TextTag::font-features" attrGet _ = getTextTagFontFeatures attrSet _ = setTextTagFontFeatures attrConstruct _ = constructTextTagFontFeatures -- VVV Prop "font-features-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagFontFeaturesSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagFontFeaturesSet obj = liftIO $ getObjectPropertyBool obj "font-features-set" setTextTagFontFeaturesSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagFontFeaturesSet obj val = liftIO $ setObjectPropertyBool obj "font-features-set" val constructTextTagFontFeaturesSet :: Bool -> IO ([Char], GValue) constructTextTagFontFeaturesSet val = constructObjectPropertyBool "font-features-set" val data TextTagFontFeaturesSetPropertyInfo instance AttrInfo TextTagFontFeaturesSetPropertyInfo where type AttrAllowedOps TextTagFontFeaturesSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagFontFeaturesSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagFontFeaturesSetPropertyInfo = TextTagK type AttrGetType TextTagFontFeaturesSetPropertyInfo = Bool type AttrLabel TextTagFontFeaturesSetPropertyInfo = "TextTag::font-features-set" attrGet _ = getTextTagFontFeaturesSet attrSet _ = setTextTagFontFeaturesSet attrConstruct _ = constructTextTagFontFeaturesSet -- VVV Prop "foreground" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setTextTagForeground :: (MonadIO m, TextTagK o) => o -> T.Text -> m () setTextTagForeground obj val = liftIO $ setObjectPropertyString obj "foreground" val constructTextTagForeground :: T.Text -> IO ([Char], GValue) constructTextTagForeground val = constructObjectPropertyString "foreground" val data TextTagForegroundPropertyInfo instance AttrInfo TextTagForegroundPropertyInfo where type AttrAllowedOps TextTagForegroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint TextTagForegroundPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextTagForegroundPropertyInfo = TextTagK type AttrGetType TextTagForegroundPropertyInfo = () type AttrLabel TextTagForegroundPropertyInfo = "TextTag::foreground" attrGet _ = undefined attrSet _ = setTextTagForeground attrConstruct _ = constructTextTagForeground -- VVV Prop "foreground-gdk" -- Type: TInterface "Gdk" "Color" -- Flags: [PropertyReadable,PropertyWritable] getTextTagForegroundGdk :: (MonadIO m, TextTagK o) => o -> m Gdk.Color getTextTagForegroundGdk obj = liftIO $ getObjectPropertyBoxed obj "foreground-gdk" Gdk.Color setTextTagForegroundGdk :: (MonadIO m, TextTagK o) => o -> Gdk.Color -> m () setTextTagForegroundGdk obj val = liftIO $ setObjectPropertyBoxed obj "foreground-gdk" val constructTextTagForegroundGdk :: Gdk.Color -> IO ([Char], GValue) constructTextTagForegroundGdk val = constructObjectPropertyBoxed "foreground-gdk" val data TextTagForegroundGdkPropertyInfo instance AttrInfo TextTagForegroundGdkPropertyInfo where type AttrAllowedOps TextTagForegroundGdkPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagForegroundGdkPropertyInfo = (~) Gdk.Color type AttrBaseTypeConstraint TextTagForegroundGdkPropertyInfo = TextTagK type AttrGetType TextTagForegroundGdkPropertyInfo = Gdk.Color type AttrLabel TextTagForegroundGdkPropertyInfo = "TextTag::foreground-gdk" attrGet _ = getTextTagForegroundGdk attrSet _ = setTextTagForegroundGdk attrConstruct _ = constructTextTagForegroundGdk -- VVV Prop "foreground-rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getTextTagForegroundRgba :: (MonadIO m, TextTagK o) => o -> m Gdk.RGBA getTextTagForegroundRgba obj = liftIO $ getObjectPropertyBoxed obj "foreground-rgba" Gdk.RGBA setTextTagForegroundRgba :: (MonadIO m, TextTagK o) => o -> Gdk.RGBA -> m () setTextTagForegroundRgba obj val = liftIO $ setObjectPropertyBoxed obj "foreground-rgba" val constructTextTagForegroundRgba :: Gdk.RGBA -> IO ([Char], GValue) constructTextTagForegroundRgba val = constructObjectPropertyBoxed "foreground-rgba" val data TextTagForegroundRgbaPropertyInfo instance AttrInfo TextTagForegroundRgbaPropertyInfo where type AttrAllowedOps TextTagForegroundRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagForegroundRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint TextTagForegroundRgbaPropertyInfo = TextTagK type AttrGetType TextTagForegroundRgbaPropertyInfo = Gdk.RGBA type AttrLabel TextTagForegroundRgbaPropertyInfo = "TextTag::foreground-rgba" attrGet _ = getTextTagForegroundRgba attrSet _ = setTextTagForegroundRgba attrConstruct _ = constructTextTagForegroundRgba -- VVV Prop "foreground-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagForegroundSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagForegroundSet obj = liftIO $ getObjectPropertyBool obj "foreground-set" setTextTagForegroundSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagForegroundSet obj val = liftIO $ setObjectPropertyBool obj "foreground-set" val constructTextTagForegroundSet :: Bool -> IO ([Char], GValue) constructTextTagForegroundSet val = constructObjectPropertyBool "foreground-set" val data TextTagForegroundSetPropertyInfo instance AttrInfo TextTagForegroundSetPropertyInfo where type AttrAllowedOps TextTagForegroundSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagForegroundSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagForegroundSetPropertyInfo = TextTagK type AttrGetType TextTagForegroundSetPropertyInfo = Bool type AttrLabel TextTagForegroundSetPropertyInfo = "TextTag::foreground-set" attrGet _ = getTextTagForegroundSet attrSet _ = setTextTagForegroundSet attrConstruct _ = constructTextTagForegroundSet -- VVV Prop "indent" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextTagIndent :: (MonadIO m, TextTagK o) => o -> m Int32 getTextTagIndent obj = liftIO $ getObjectPropertyCInt obj "indent" setTextTagIndent :: (MonadIO m, TextTagK o) => o -> Int32 -> m () setTextTagIndent obj val = liftIO $ setObjectPropertyCInt obj "indent" val constructTextTagIndent :: Int32 -> IO ([Char], GValue) constructTextTagIndent val = constructObjectPropertyCInt "indent" val data TextTagIndentPropertyInfo instance AttrInfo TextTagIndentPropertyInfo where type AttrAllowedOps TextTagIndentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagIndentPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextTagIndentPropertyInfo = TextTagK type AttrGetType TextTagIndentPropertyInfo = Int32 type AttrLabel TextTagIndentPropertyInfo = "TextTag::indent" attrGet _ = getTextTagIndent attrSet _ = setTextTagIndent attrConstruct _ = constructTextTagIndent -- VVV Prop "indent-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagIndentSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagIndentSet obj = liftIO $ getObjectPropertyBool obj "indent-set" setTextTagIndentSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagIndentSet obj val = liftIO $ setObjectPropertyBool obj "indent-set" val constructTextTagIndentSet :: Bool -> IO ([Char], GValue) constructTextTagIndentSet val = constructObjectPropertyBool "indent-set" val data TextTagIndentSetPropertyInfo instance AttrInfo TextTagIndentSetPropertyInfo where type AttrAllowedOps TextTagIndentSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagIndentSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagIndentSetPropertyInfo = TextTagK type AttrGetType TextTagIndentSetPropertyInfo = Bool type AttrLabel TextTagIndentSetPropertyInfo = "TextTag::indent-set" attrGet _ = getTextTagIndentSet attrSet _ = setTextTagIndentSet attrConstruct _ = constructTextTagIndentSet -- VVV Prop "invisible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagInvisible :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagInvisible obj = liftIO $ getObjectPropertyBool obj "invisible" setTextTagInvisible :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagInvisible obj val = liftIO $ setObjectPropertyBool obj "invisible" val constructTextTagInvisible :: Bool -> IO ([Char], GValue) constructTextTagInvisible val = constructObjectPropertyBool "invisible" val data TextTagInvisiblePropertyInfo instance AttrInfo TextTagInvisiblePropertyInfo where type AttrAllowedOps TextTagInvisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagInvisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagInvisiblePropertyInfo = TextTagK type AttrGetType TextTagInvisiblePropertyInfo = Bool type AttrLabel TextTagInvisiblePropertyInfo = "TextTag::invisible" attrGet _ = getTextTagInvisible attrSet _ = setTextTagInvisible attrConstruct _ = constructTextTagInvisible -- VVV Prop "invisible-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagInvisibleSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagInvisibleSet obj = liftIO $ getObjectPropertyBool obj "invisible-set" setTextTagInvisibleSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagInvisibleSet obj val = liftIO $ setObjectPropertyBool obj "invisible-set" val constructTextTagInvisibleSet :: Bool -> IO ([Char], GValue) constructTextTagInvisibleSet val = constructObjectPropertyBool "invisible-set" val data TextTagInvisibleSetPropertyInfo instance AttrInfo TextTagInvisibleSetPropertyInfo where type AttrAllowedOps TextTagInvisibleSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagInvisibleSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagInvisibleSetPropertyInfo = TextTagK type AttrGetType TextTagInvisibleSetPropertyInfo = Bool type AttrLabel TextTagInvisibleSetPropertyInfo = "TextTag::invisible-set" attrGet _ = getTextTagInvisibleSet attrSet _ = setTextTagInvisibleSet attrConstruct _ = constructTextTagInvisibleSet -- VVV Prop "justification" -- Type: TInterface "Gtk" "Justification" -- Flags: [PropertyReadable,PropertyWritable] getTextTagJustification :: (MonadIO m, TextTagK o) => o -> m Justification getTextTagJustification obj = liftIO $ getObjectPropertyEnum obj "justification" setTextTagJustification :: (MonadIO m, TextTagK o) => o -> Justification -> m () setTextTagJustification obj val = liftIO $ setObjectPropertyEnum obj "justification" val constructTextTagJustification :: Justification -> IO ([Char], GValue) constructTextTagJustification val = constructObjectPropertyEnum "justification" val data TextTagJustificationPropertyInfo instance AttrInfo TextTagJustificationPropertyInfo where type AttrAllowedOps TextTagJustificationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagJustificationPropertyInfo = (~) Justification type AttrBaseTypeConstraint TextTagJustificationPropertyInfo = TextTagK type AttrGetType TextTagJustificationPropertyInfo = Justification type AttrLabel TextTagJustificationPropertyInfo = "TextTag::justification" attrGet _ = getTextTagJustification attrSet _ = setTextTagJustification attrConstruct _ = constructTextTagJustification -- VVV Prop "justification-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagJustificationSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagJustificationSet obj = liftIO $ getObjectPropertyBool obj "justification-set" setTextTagJustificationSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagJustificationSet obj val = liftIO $ setObjectPropertyBool obj "justification-set" val constructTextTagJustificationSet :: Bool -> IO ([Char], GValue) constructTextTagJustificationSet val = constructObjectPropertyBool "justification-set" val data TextTagJustificationSetPropertyInfo instance AttrInfo TextTagJustificationSetPropertyInfo where type AttrAllowedOps TextTagJustificationSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagJustificationSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagJustificationSetPropertyInfo = TextTagK type AttrGetType TextTagJustificationSetPropertyInfo = Bool type AttrLabel TextTagJustificationSetPropertyInfo = "TextTag::justification-set" attrGet _ = getTextTagJustificationSet attrSet _ = setTextTagJustificationSet attrConstruct _ = constructTextTagJustificationSet -- VVV Prop "language" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getTextTagLanguage :: (MonadIO m, TextTagK o) => o -> m T.Text getTextTagLanguage obj = liftIO $ getObjectPropertyString obj "language" setTextTagLanguage :: (MonadIO m, TextTagK o) => o -> T.Text -> m () setTextTagLanguage obj val = liftIO $ setObjectPropertyString obj "language" val constructTextTagLanguage :: T.Text -> IO ([Char], GValue) constructTextTagLanguage val = constructObjectPropertyString "language" val data TextTagLanguagePropertyInfo instance AttrInfo TextTagLanguagePropertyInfo where type AttrAllowedOps TextTagLanguagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagLanguagePropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextTagLanguagePropertyInfo = TextTagK type AttrGetType TextTagLanguagePropertyInfo = T.Text type AttrLabel TextTagLanguagePropertyInfo = "TextTag::language" attrGet _ = getTextTagLanguage attrSet _ = setTextTagLanguage attrConstruct _ = constructTextTagLanguage -- VVV Prop "language-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagLanguageSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagLanguageSet obj = liftIO $ getObjectPropertyBool obj "language-set" setTextTagLanguageSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagLanguageSet obj val = liftIO $ setObjectPropertyBool obj "language-set" val constructTextTagLanguageSet :: Bool -> IO ([Char], GValue) constructTextTagLanguageSet val = constructObjectPropertyBool "language-set" val data TextTagLanguageSetPropertyInfo instance AttrInfo TextTagLanguageSetPropertyInfo where type AttrAllowedOps TextTagLanguageSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagLanguageSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagLanguageSetPropertyInfo = TextTagK type AttrGetType TextTagLanguageSetPropertyInfo = Bool type AttrLabel TextTagLanguageSetPropertyInfo = "TextTag::language-set" attrGet _ = getTextTagLanguageSet attrSet _ = setTextTagLanguageSet attrConstruct _ = constructTextTagLanguageSet -- VVV Prop "left-margin" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextTagLeftMargin :: (MonadIO m, TextTagK o) => o -> m Int32 getTextTagLeftMargin obj = liftIO $ getObjectPropertyCInt obj "left-margin" setTextTagLeftMargin :: (MonadIO m, TextTagK o) => o -> Int32 -> m () setTextTagLeftMargin obj val = liftIO $ setObjectPropertyCInt obj "left-margin" val constructTextTagLeftMargin :: Int32 -> IO ([Char], GValue) constructTextTagLeftMargin val = constructObjectPropertyCInt "left-margin" val data TextTagLeftMarginPropertyInfo instance AttrInfo TextTagLeftMarginPropertyInfo where type AttrAllowedOps TextTagLeftMarginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagLeftMarginPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextTagLeftMarginPropertyInfo = TextTagK type AttrGetType TextTagLeftMarginPropertyInfo = Int32 type AttrLabel TextTagLeftMarginPropertyInfo = "TextTag::left-margin" attrGet _ = getTextTagLeftMargin attrSet _ = setTextTagLeftMargin attrConstruct _ = constructTextTagLeftMargin -- VVV Prop "left-margin-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagLeftMarginSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagLeftMarginSet obj = liftIO $ getObjectPropertyBool obj "left-margin-set" setTextTagLeftMarginSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagLeftMarginSet obj val = liftIO $ setObjectPropertyBool obj "left-margin-set" val constructTextTagLeftMarginSet :: Bool -> IO ([Char], GValue) constructTextTagLeftMarginSet val = constructObjectPropertyBool "left-margin-set" val data TextTagLeftMarginSetPropertyInfo instance AttrInfo TextTagLeftMarginSetPropertyInfo where type AttrAllowedOps TextTagLeftMarginSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagLeftMarginSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagLeftMarginSetPropertyInfo = TextTagK type AttrGetType TextTagLeftMarginSetPropertyInfo = Bool type AttrLabel TextTagLeftMarginSetPropertyInfo = "TextTag::left-margin-set" attrGet _ = getTextTagLeftMarginSet attrSet _ = setTextTagLeftMarginSet attrConstruct _ = constructTextTagLeftMarginSet -- VVV Prop "letter-spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextTagLetterSpacing :: (MonadIO m, TextTagK o) => o -> m Int32 getTextTagLetterSpacing obj = liftIO $ getObjectPropertyCInt obj "letter-spacing" setTextTagLetterSpacing :: (MonadIO m, TextTagK o) => o -> Int32 -> m () setTextTagLetterSpacing obj val = liftIO $ setObjectPropertyCInt obj "letter-spacing" val constructTextTagLetterSpacing :: Int32 -> IO ([Char], GValue) constructTextTagLetterSpacing val = constructObjectPropertyCInt "letter-spacing" val data TextTagLetterSpacingPropertyInfo instance AttrInfo TextTagLetterSpacingPropertyInfo where type AttrAllowedOps TextTagLetterSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagLetterSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextTagLetterSpacingPropertyInfo = TextTagK type AttrGetType TextTagLetterSpacingPropertyInfo = Int32 type AttrLabel TextTagLetterSpacingPropertyInfo = "TextTag::letter-spacing" attrGet _ = getTextTagLetterSpacing attrSet _ = setTextTagLetterSpacing attrConstruct _ = constructTextTagLetterSpacing -- VVV Prop "letter-spacing-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagLetterSpacingSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagLetterSpacingSet obj = liftIO $ getObjectPropertyBool obj "letter-spacing-set" setTextTagLetterSpacingSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagLetterSpacingSet obj val = liftIO $ setObjectPropertyBool obj "letter-spacing-set" val constructTextTagLetterSpacingSet :: Bool -> IO ([Char], GValue) constructTextTagLetterSpacingSet val = constructObjectPropertyBool "letter-spacing-set" val data TextTagLetterSpacingSetPropertyInfo instance AttrInfo TextTagLetterSpacingSetPropertyInfo where type AttrAllowedOps TextTagLetterSpacingSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagLetterSpacingSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagLetterSpacingSetPropertyInfo = TextTagK type AttrGetType TextTagLetterSpacingSetPropertyInfo = Bool type AttrLabel TextTagLetterSpacingSetPropertyInfo = "TextTag::letter-spacing-set" attrGet _ = getTextTagLetterSpacingSet attrSet _ = setTextTagLetterSpacingSet attrConstruct _ = constructTextTagLetterSpacingSet -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTextTagName :: (MonadIO m, TextTagK o) => o -> m T.Text getTextTagName obj = liftIO $ getObjectPropertyString obj "name" constructTextTagName :: T.Text -> IO ([Char], GValue) constructTextTagName val = constructObjectPropertyString "name" val data TextTagNamePropertyInfo instance AttrInfo TextTagNamePropertyInfo where type AttrAllowedOps TextTagNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextTagNamePropertyInfo = TextTagK type AttrGetType TextTagNamePropertyInfo = T.Text type AttrLabel TextTagNamePropertyInfo = "TextTag::name" attrGet _ = getTextTagName attrSet _ = undefined attrConstruct _ = constructTextTagName -- VVV Prop "paragraph-background" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setTextTagParagraphBackground :: (MonadIO m, TextTagK o) => o -> T.Text -> m () setTextTagParagraphBackground obj val = liftIO $ setObjectPropertyString obj "paragraph-background" val constructTextTagParagraphBackground :: T.Text -> IO ([Char], GValue) constructTextTagParagraphBackground val = constructObjectPropertyString "paragraph-background" val data TextTagParagraphBackgroundPropertyInfo instance AttrInfo TextTagParagraphBackgroundPropertyInfo where type AttrAllowedOps TextTagParagraphBackgroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint TextTagParagraphBackgroundPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextTagParagraphBackgroundPropertyInfo = TextTagK type AttrGetType TextTagParagraphBackgroundPropertyInfo = () type AttrLabel TextTagParagraphBackgroundPropertyInfo = "TextTag::paragraph-background" attrGet _ = undefined attrSet _ = setTextTagParagraphBackground attrConstruct _ = constructTextTagParagraphBackground -- VVV Prop "paragraph-background-gdk" -- Type: TInterface "Gdk" "Color" -- Flags: [PropertyReadable,PropertyWritable] getTextTagParagraphBackgroundGdk :: (MonadIO m, TextTagK o) => o -> m Gdk.Color getTextTagParagraphBackgroundGdk obj = liftIO $ getObjectPropertyBoxed obj "paragraph-background-gdk" Gdk.Color setTextTagParagraphBackgroundGdk :: (MonadIO m, TextTagK o) => o -> Gdk.Color -> m () setTextTagParagraphBackgroundGdk obj val = liftIO $ setObjectPropertyBoxed obj "paragraph-background-gdk" val constructTextTagParagraphBackgroundGdk :: Gdk.Color -> IO ([Char], GValue) constructTextTagParagraphBackgroundGdk val = constructObjectPropertyBoxed "paragraph-background-gdk" val data TextTagParagraphBackgroundGdkPropertyInfo instance AttrInfo TextTagParagraphBackgroundGdkPropertyInfo where type AttrAllowedOps TextTagParagraphBackgroundGdkPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagParagraphBackgroundGdkPropertyInfo = (~) Gdk.Color type AttrBaseTypeConstraint TextTagParagraphBackgroundGdkPropertyInfo = TextTagK type AttrGetType TextTagParagraphBackgroundGdkPropertyInfo = Gdk.Color type AttrLabel TextTagParagraphBackgroundGdkPropertyInfo = "TextTag::paragraph-background-gdk" attrGet _ = getTextTagParagraphBackgroundGdk attrSet _ = setTextTagParagraphBackgroundGdk attrConstruct _ = constructTextTagParagraphBackgroundGdk -- VVV Prop "paragraph-background-rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getTextTagParagraphBackgroundRgba :: (MonadIO m, TextTagK o) => o -> m Gdk.RGBA getTextTagParagraphBackgroundRgba obj = liftIO $ getObjectPropertyBoxed obj "paragraph-background-rgba" Gdk.RGBA setTextTagParagraphBackgroundRgba :: (MonadIO m, TextTagK o) => o -> Gdk.RGBA -> m () setTextTagParagraphBackgroundRgba obj val = liftIO $ setObjectPropertyBoxed obj "paragraph-background-rgba" val constructTextTagParagraphBackgroundRgba :: Gdk.RGBA -> IO ([Char], GValue) constructTextTagParagraphBackgroundRgba val = constructObjectPropertyBoxed "paragraph-background-rgba" val data TextTagParagraphBackgroundRgbaPropertyInfo instance AttrInfo TextTagParagraphBackgroundRgbaPropertyInfo where type AttrAllowedOps TextTagParagraphBackgroundRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagParagraphBackgroundRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint TextTagParagraphBackgroundRgbaPropertyInfo = TextTagK type AttrGetType TextTagParagraphBackgroundRgbaPropertyInfo = Gdk.RGBA type AttrLabel TextTagParagraphBackgroundRgbaPropertyInfo = "TextTag::paragraph-background-rgba" attrGet _ = getTextTagParagraphBackgroundRgba attrSet _ = setTextTagParagraphBackgroundRgba attrConstruct _ = constructTextTagParagraphBackgroundRgba -- VVV Prop "paragraph-background-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagParagraphBackgroundSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagParagraphBackgroundSet obj = liftIO $ getObjectPropertyBool obj "paragraph-background-set" setTextTagParagraphBackgroundSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagParagraphBackgroundSet obj val = liftIO $ setObjectPropertyBool obj "paragraph-background-set" val constructTextTagParagraphBackgroundSet :: Bool -> IO ([Char], GValue) constructTextTagParagraphBackgroundSet val = constructObjectPropertyBool "paragraph-background-set" val data TextTagParagraphBackgroundSetPropertyInfo instance AttrInfo TextTagParagraphBackgroundSetPropertyInfo where type AttrAllowedOps TextTagParagraphBackgroundSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagParagraphBackgroundSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagParagraphBackgroundSetPropertyInfo = TextTagK type AttrGetType TextTagParagraphBackgroundSetPropertyInfo = Bool type AttrLabel TextTagParagraphBackgroundSetPropertyInfo = "TextTag::paragraph-background-set" attrGet _ = getTextTagParagraphBackgroundSet attrSet _ = setTextTagParagraphBackgroundSet attrConstruct _ = constructTextTagParagraphBackgroundSet -- VVV Prop "pixels-above-lines" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextTagPixelsAboveLines :: (MonadIO m, TextTagK o) => o -> m Int32 getTextTagPixelsAboveLines obj = liftIO $ getObjectPropertyCInt obj "pixels-above-lines" setTextTagPixelsAboveLines :: (MonadIO m, TextTagK o) => o -> Int32 -> m () setTextTagPixelsAboveLines obj val = liftIO $ setObjectPropertyCInt obj "pixels-above-lines" val constructTextTagPixelsAboveLines :: Int32 -> IO ([Char], GValue) constructTextTagPixelsAboveLines val = constructObjectPropertyCInt "pixels-above-lines" val data TextTagPixelsAboveLinesPropertyInfo instance AttrInfo TextTagPixelsAboveLinesPropertyInfo where type AttrAllowedOps TextTagPixelsAboveLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagPixelsAboveLinesPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextTagPixelsAboveLinesPropertyInfo = TextTagK type AttrGetType TextTagPixelsAboveLinesPropertyInfo = Int32 type AttrLabel TextTagPixelsAboveLinesPropertyInfo = "TextTag::pixels-above-lines" attrGet _ = getTextTagPixelsAboveLines attrSet _ = setTextTagPixelsAboveLines attrConstruct _ = constructTextTagPixelsAboveLines -- VVV Prop "pixels-above-lines-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagPixelsAboveLinesSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagPixelsAboveLinesSet obj = liftIO $ getObjectPropertyBool obj "pixels-above-lines-set" setTextTagPixelsAboveLinesSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagPixelsAboveLinesSet obj val = liftIO $ setObjectPropertyBool obj "pixels-above-lines-set" val constructTextTagPixelsAboveLinesSet :: Bool -> IO ([Char], GValue) constructTextTagPixelsAboveLinesSet val = constructObjectPropertyBool "pixels-above-lines-set" val data TextTagPixelsAboveLinesSetPropertyInfo instance AttrInfo TextTagPixelsAboveLinesSetPropertyInfo where type AttrAllowedOps TextTagPixelsAboveLinesSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagPixelsAboveLinesSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagPixelsAboveLinesSetPropertyInfo = TextTagK type AttrGetType TextTagPixelsAboveLinesSetPropertyInfo = Bool type AttrLabel TextTagPixelsAboveLinesSetPropertyInfo = "TextTag::pixels-above-lines-set" attrGet _ = getTextTagPixelsAboveLinesSet attrSet _ = setTextTagPixelsAboveLinesSet attrConstruct _ = constructTextTagPixelsAboveLinesSet -- VVV Prop "pixels-below-lines" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextTagPixelsBelowLines :: (MonadIO m, TextTagK o) => o -> m Int32 getTextTagPixelsBelowLines obj = liftIO $ getObjectPropertyCInt obj "pixels-below-lines" setTextTagPixelsBelowLines :: (MonadIO m, TextTagK o) => o -> Int32 -> m () setTextTagPixelsBelowLines obj val = liftIO $ setObjectPropertyCInt obj "pixels-below-lines" val constructTextTagPixelsBelowLines :: Int32 -> IO ([Char], GValue) constructTextTagPixelsBelowLines val = constructObjectPropertyCInt "pixels-below-lines" val data TextTagPixelsBelowLinesPropertyInfo instance AttrInfo TextTagPixelsBelowLinesPropertyInfo where type AttrAllowedOps TextTagPixelsBelowLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagPixelsBelowLinesPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextTagPixelsBelowLinesPropertyInfo = TextTagK type AttrGetType TextTagPixelsBelowLinesPropertyInfo = Int32 type AttrLabel TextTagPixelsBelowLinesPropertyInfo = "TextTag::pixels-below-lines" attrGet _ = getTextTagPixelsBelowLines attrSet _ = setTextTagPixelsBelowLines attrConstruct _ = constructTextTagPixelsBelowLines -- VVV Prop "pixels-below-lines-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagPixelsBelowLinesSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagPixelsBelowLinesSet obj = liftIO $ getObjectPropertyBool obj "pixels-below-lines-set" setTextTagPixelsBelowLinesSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagPixelsBelowLinesSet obj val = liftIO $ setObjectPropertyBool obj "pixels-below-lines-set" val constructTextTagPixelsBelowLinesSet :: Bool -> IO ([Char], GValue) constructTextTagPixelsBelowLinesSet val = constructObjectPropertyBool "pixels-below-lines-set" val data TextTagPixelsBelowLinesSetPropertyInfo instance AttrInfo TextTagPixelsBelowLinesSetPropertyInfo where type AttrAllowedOps TextTagPixelsBelowLinesSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagPixelsBelowLinesSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagPixelsBelowLinesSetPropertyInfo = TextTagK type AttrGetType TextTagPixelsBelowLinesSetPropertyInfo = Bool type AttrLabel TextTagPixelsBelowLinesSetPropertyInfo = "TextTag::pixels-below-lines-set" attrGet _ = getTextTagPixelsBelowLinesSet attrSet _ = setTextTagPixelsBelowLinesSet attrConstruct _ = constructTextTagPixelsBelowLinesSet -- VVV Prop "pixels-inside-wrap" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextTagPixelsInsideWrap :: (MonadIO m, TextTagK o) => o -> m Int32 getTextTagPixelsInsideWrap obj = liftIO $ getObjectPropertyCInt obj "pixels-inside-wrap" setTextTagPixelsInsideWrap :: (MonadIO m, TextTagK o) => o -> Int32 -> m () setTextTagPixelsInsideWrap obj val = liftIO $ setObjectPropertyCInt obj "pixels-inside-wrap" val constructTextTagPixelsInsideWrap :: Int32 -> IO ([Char], GValue) constructTextTagPixelsInsideWrap val = constructObjectPropertyCInt "pixels-inside-wrap" val data TextTagPixelsInsideWrapPropertyInfo instance AttrInfo TextTagPixelsInsideWrapPropertyInfo where type AttrAllowedOps TextTagPixelsInsideWrapPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagPixelsInsideWrapPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextTagPixelsInsideWrapPropertyInfo = TextTagK type AttrGetType TextTagPixelsInsideWrapPropertyInfo = Int32 type AttrLabel TextTagPixelsInsideWrapPropertyInfo = "TextTag::pixels-inside-wrap" attrGet _ = getTextTagPixelsInsideWrap attrSet _ = setTextTagPixelsInsideWrap attrConstruct _ = constructTextTagPixelsInsideWrap -- VVV Prop "pixels-inside-wrap-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagPixelsInsideWrapSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagPixelsInsideWrapSet obj = liftIO $ getObjectPropertyBool obj "pixels-inside-wrap-set" setTextTagPixelsInsideWrapSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagPixelsInsideWrapSet obj val = liftIO $ setObjectPropertyBool obj "pixels-inside-wrap-set" val constructTextTagPixelsInsideWrapSet :: Bool -> IO ([Char], GValue) constructTextTagPixelsInsideWrapSet val = constructObjectPropertyBool "pixels-inside-wrap-set" val data TextTagPixelsInsideWrapSetPropertyInfo instance AttrInfo TextTagPixelsInsideWrapSetPropertyInfo where type AttrAllowedOps TextTagPixelsInsideWrapSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagPixelsInsideWrapSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagPixelsInsideWrapSetPropertyInfo = TextTagK type AttrGetType TextTagPixelsInsideWrapSetPropertyInfo = Bool type AttrLabel TextTagPixelsInsideWrapSetPropertyInfo = "TextTag::pixels-inside-wrap-set" attrGet _ = getTextTagPixelsInsideWrapSet attrSet _ = setTextTagPixelsInsideWrapSet attrConstruct _ = constructTextTagPixelsInsideWrapSet -- VVV Prop "right-margin" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextTagRightMargin :: (MonadIO m, TextTagK o) => o -> m Int32 getTextTagRightMargin obj = liftIO $ getObjectPropertyCInt obj "right-margin" setTextTagRightMargin :: (MonadIO m, TextTagK o) => o -> Int32 -> m () setTextTagRightMargin obj val = liftIO $ setObjectPropertyCInt obj "right-margin" val constructTextTagRightMargin :: Int32 -> IO ([Char], GValue) constructTextTagRightMargin val = constructObjectPropertyCInt "right-margin" val data TextTagRightMarginPropertyInfo instance AttrInfo TextTagRightMarginPropertyInfo where type AttrAllowedOps TextTagRightMarginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagRightMarginPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextTagRightMarginPropertyInfo = TextTagK type AttrGetType TextTagRightMarginPropertyInfo = Int32 type AttrLabel TextTagRightMarginPropertyInfo = "TextTag::right-margin" attrGet _ = getTextTagRightMargin attrSet _ = setTextTagRightMargin attrConstruct _ = constructTextTagRightMargin -- VVV Prop "right-margin-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagRightMarginSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagRightMarginSet obj = liftIO $ getObjectPropertyBool obj "right-margin-set" setTextTagRightMarginSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagRightMarginSet obj val = liftIO $ setObjectPropertyBool obj "right-margin-set" val constructTextTagRightMarginSet :: Bool -> IO ([Char], GValue) constructTextTagRightMarginSet val = constructObjectPropertyBool "right-margin-set" val data TextTagRightMarginSetPropertyInfo instance AttrInfo TextTagRightMarginSetPropertyInfo where type AttrAllowedOps TextTagRightMarginSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagRightMarginSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagRightMarginSetPropertyInfo = TextTagK type AttrGetType TextTagRightMarginSetPropertyInfo = Bool type AttrLabel TextTagRightMarginSetPropertyInfo = "TextTag::right-margin-set" attrGet _ = getTextTagRightMarginSet attrSet _ = setTextTagRightMarginSet attrConstruct _ = constructTextTagRightMarginSet -- VVV Prop "rise" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextTagRise :: (MonadIO m, TextTagK o) => o -> m Int32 getTextTagRise obj = liftIO $ getObjectPropertyCInt obj "rise" setTextTagRise :: (MonadIO m, TextTagK o) => o -> Int32 -> m () setTextTagRise obj val = liftIO $ setObjectPropertyCInt obj "rise" val constructTextTagRise :: Int32 -> IO ([Char], GValue) constructTextTagRise val = constructObjectPropertyCInt "rise" val data TextTagRisePropertyInfo instance AttrInfo TextTagRisePropertyInfo where type AttrAllowedOps TextTagRisePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagRisePropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextTagRisePropertyInfo = TextTagK type AttrGetType TextTagRisePropertyInfo = Int32 type AttrLabel TextTagRisePropertyInfo = "TextTag::rise" attrGet _ = getTextTagRise attrSet _ = setTextTagRise attrConstruct _ = constructTextTagRise -- VVV Prop "rise-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagRiseSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagRiseSet obj = liftIO $ getObjectPropertyBool obj "rise-set" setTextTagRiseSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagRiseSet obj val = liftIO $ setObjectPropertyBool obj "rise-set" val constructTextTagRiseSet :: Bool -> IO ([Char], GValue) constructTextTagRiseSet val = constructObjectPropertyBool "rise-set" val data TextTagRiseSetPropertyInfo instance AttrInfo TextTagRiseSetPropertyInfo where type AttrAllowedOps TextTagRiseSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagRiseSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagRiseSetPropertyInfo = TextTagK type AttrGetType TextTagRiseSetPropertyInfo = Bool type AttrLabel TextTagRiseSetPropertyInfo = "TextTag::rise-set" attrGet _ = getTextTagRiseSet attrSet _ = setTextTagRiseSet attrConstruct _ = constructTextTagRiseSet -- VVV Prop "scale" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getTextTagScale :: (MonadIO m, TextTagK o) => o -> m Double getTextTagScale obj = liftIO $ getObjectPropertyDouble obj "scale" setTextTagScale :: (MonadIO m, TextTagK o) => o -> Double -> m () setTextTagScale obj val = liftIO $ setObjectPropertyDouble obj "scale" val constructTextTagScale :: Double -> IO ([Char], GValue) constructTextTagScale val = constructObjectPropertyDouble "scale" val data TextTagScalePropertyInfo instance AttrInfo TextTagScalePropertyInfo where type AttrAllowedOps TextTagScalePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagScalePropertyInfo = (~) Double type AttrBaseTypeConstraint TextTagScalePropertyInfo = TextTagK type AttrGetType TextTagScalePropertyInfo = Double type AttrLabel TextTagScalePropertyInfo = "TextTag::scale" attrGet _ = getTextTagScale attrSet _ = setTextTagScale attrConstruct _ = constructTextTagScale -- VVV Prop "scale-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagScaleSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagScaleSet obj = liftIO $ getObjectPropertyBool obj "scale-set" setTextTagScaleSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagScaleSet obj val = liftIO $ setObjectPropertyBool obj "scale-set" val constructTextTagScaleSet :: Bool -> IO ([Char], GValue) constructTextTagScaleSet val = constructObjectPropertyBool "scale-set" val data TextTagScaleSetPropertyInfo instance AttrInfo TextTagScaleSetPropertyInfo where type AttrAllowedOps TextTagScaleSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagScaleSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagScaleSetPropertyInfo = TextTagK type AttrGetType TextTagScaleSetPropertyInfo = Bool type AttrLabel TextTagScaleSetPropertyInfo = "TextTag::scale-set" attrGet _ = getTextTagScaleSet attrSet _ = setTextTagScaleSet attrConstruct _ = constructTextTagScaleSet -- VVV Prop "size" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextTagSize :: (MonadIO m, TextTagK o) => o -> m Int32 getTextTagSize obj = liftIO $ getObjectPropertyCInt obj "size" setTextTagSize :: (MonadIO m, TextTagK o) => o -> Int32 -> m () setTextTagSize obj val = liftIO $ setObjectPropertyCInt obj "size" val constructTextTagSize :: Int32 -> IO ([Char], GValue) constructTextTagSize val = constructObjectPropertyCInt "size" val data TextTagSizePropertyInfo instance AttrInfo TextTagSizePropertyInfo where type AttrAllowedOps TextTagSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagSizePropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextTagSizePropertyInfo = TextTagK type AttrGetType TextTagSizePropertyInfo = Int32 type AttrLabel TextTagSizePropertyInfo = "TextTag::size" attrGet _ = getTextTagSize attrSet _ = setTextTagSize attrConstruct _ = constructTextTagSize -- VVV Prop "size-points" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getTextTagSizePoints :: (MonadIO m, TextTagK o) => o -> m Double getTextTagSizePoints obj = liftIO $ getObjectPropertyDouble obj "size-points" setTextTagSizePoints :: (MonadIO m, TextTagK o) => o -> Double -> m () setTextTagSizePoints obj val = liftIO $ setObjectPropertyDouble obj "size-points" val constructTextTagSizePoints :: Double -> IO ([Char], GValue) constructTextTagSizePoints val = constructObjectPropertyDouble "size-points" val data TextTagSizePointsPropertyInfo instance AttrInfo TextTagSizePointsPropertyInfo where type AttrAllowedOps TextTagSizePointsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagSizePointsPropertyInfo = (~) Double type AttrBaseTypeConstraint TextTagSizePointsPropertyInfo = TextTagK type AttrGetType TextTagSizePointsPropertyInfo = Double type AttrLabel TextTagSizePointsPropertyInfo = "TextTag::size-points" attrGet _ = getTextTagSizePoints attrSet _ = setTextTagSizePoints attrConstruct _ = constructTextTagSizePoints -- VVV Prop "size-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagSizeSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagSizeSet obj = liftIO $ getObjectPropertyBool obj "size-set" setTextTagSizeSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagSizeSet obj val = liftIO $ setObjectPropertyBool obj "size-set" val constructTextTagSizeSet :: Bool -> IO ([Char], GValue) constructTextTagSizeSet val = constructObjectPropertyBool "size-set" val data TextTagSizeSetPropertyInfo instance AttrInfo TextTagSizeSetPropertyInfo where type AttrAllowedOps TextTagSizeSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagSizeSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagSizeSetPropertyInfo = TextTagK type AttrGetType TextTagSizeSetPropertyInfo = Bool type AttrLabel TextTagSizeSetPropertyInfo = "TextTag::size-set" attrGet _ = getTextTagSizeSet attrSet _ = setTextTagSizeSet attrConstruct _ = constructTextTagSizeSet -- VVV Prop "stretch" -- Type: TInterface "Pango" "Stretch" -- Flags: [PropertyReadable,PropertyWritable] getTextTagStretch :: (MonadIO m, TextTagK o) => o -> m Pango.Stretch getTextTagStretch obj = liftIO $ getObjectPropertyEnum obj "stretch" setTextTagStretch :: (MonadIO m, TextTagK o) => o -> Pango.Stretch -> m () setTextTagStretch obj val = liftIO $ setObjectPropertyEnum obj "stretch" val constructTextTagStretch :: Pango.Stretch -> IO ([Char], GValue) constructTextTagStretch val = constructObjectPropertyEnum "stretch" val data TextTagStretchPropertyInfo instance AttrInfo TextTagStretchPropertyInfo where type AttrAllowedOps TextTagStretchPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagStretchPropertyInfo = (~) Pango.Stretch type AttrBaseTypeConstraint TextTagStretchPropertyInfo = TextTagK type AttrGetType TextTagStretchPropertyInfo = Pango.Stretch type AttrLabel TextTagStretchPropertyInfo = "TextTag::stretch" attrGet _ = getTextTagStretch attrSet _ = setTextTagStretch attrConstruct _ = constructTextTagStretch -- VVV Prop "stretch-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagStretchSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagStretchSet obj = liftIO $ getObjectPropertyBool obj "stretch-set" setTextTagStretchSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagStretchSet obj val = liftIO $ setObjectPropertyBool obj "stretch-set" val constructTextTagStretchSet :: Bool -> IO ([Char], GValue) constructTextTagStretchSet val = constructObjectPropertyBool "stretch-set" val data TextTagStretchSetPropertyInfo instance AttrInfo TextTagStretchSetPropertyInfo where type AttrAllowedOps TextTagStretchSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagStretchSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagStretchSetPropertyInfo = TextTagK type AttrGetType TextTagStretchSetPropertyInfo = Bool type AttrLabel TextTagStretchSetPropertyInfo = "TextTag::stretch-set" attrGet _ = getTextTagStretchSet attrSet _ = setTextTagStretchSet attrConstruct _ = constructTextTagStretchSet -- VVV Prop "strikethrough" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagStrikethrough :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagStrikethrough obj = liftIO $ getObjectPropertyBool obj "strikethrough" setTextTagStrikethrough :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagStrikethrough obj val = liftIO $ setObjectPropertyBool obj "strikethrough" val constructTextTagStrikethrough :: Bool -> IO ([Char], GValue) constructTextTagStrikethrough val = constructObjectPropertyBool "strikethrough" val data TextTagStrikethroughPropertyInfo instance AttrInfo TextTagStrikethroughPropertyInfo where type AttrAllowedOps TextTagStrikethroughPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagStrikethroughPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagStrikethroughPropertyInfo = TextTagK type AttrGetType TextTagStrikethroughPropertyInfo = Bool type AttrLabel TextTagStrikethroughPropertyInfo = "TextTag::strikethrough" attrGet _ = getTextTagStrikethrough attrSet _ = setTextTagStrikethrough attrConstruct _ = constructTextTagStrikethrough -- VVV Prop "strikethrough-rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getTextTagStrikethroughRgba :: (MonadIO m, TextTagK o) => o -> m Gdk.RGBA getTextTagStrikethroughRgba obj = liftIO $ getObjectPropertyBoxed obj "strikethrough-rgba" Gdk.RGBA setTextTagStrikethroughRgba :: (MonadIO m, TextTagK o) => o -> Gdk.RGBA -> m () setTextTagStrikethroughRgba obj val = liftIO $ setObjectPropertyBoxed obj "strikethrough-rgba" val constructTextTagStrikethroughRgba :: Gdk.RGBA -> IO ([Char], GValue) constructTextTagStrikethroughRgba val = constructObjectPropertyBoxed "strikethrough-rgba" val data TextTagStrikethroughRgbaPropertyInfo instance AttrInfo TextTagStrikethroughRgbaPropertyInfo where type AttrAllowedOps TextTagStrikethroughRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagStrikethroughRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint TextTagStrikethroughRgbaPropertyInfo = TextTagK type AttrGetType TextTagStrikethroughRgbaPropertyInfo = Gdk.RGBA type AttrLabel TextTagStrikethroughRgbaPropertyInfo = "TextTag::strikethrough-rgba" attrGet _ = getTextTagStrikethroughRgba attrSet _ = setTextTagStrikethroughRgba attrConstruct _ = constructTextTagStrikethroughRgba -- VVV Prop "strikethrough-rgba-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagStrikethroughRgbaSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagStrikethroughRgbaSet obj = liftIO $ getObjectPropertyBool obj "strikethrough-rgba-set" setTextTagStrikethroughRgbaSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagStrikethroughRgbaSet obj val = liftIO $ setObjectPropertyBool obj "strikethrough-rgba-set" val constructTextTagStrikethroughRgbaSet :: Bool -> IO ([Char], GValue) constructTextTagStrikethroughRgbaSet val = constructObjectPropertyBool "strikethrough-rgba-set" val data TextTagStrikethroughRgbaSetPropertyInfo instance AttrInfo TextTagStrikethroughRgbaSetPropertyInfo where type AttrAllowedOps TextTagStrikethroughRgbaSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagStrikethroughRgbaSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagStrikethroughRgbaSetPropertyInfo = TextTagK type AttrGetType TextTagStrikethroughRgbaSetPropertyInfo = Bool type AttrLabel TextTagStrikethroughRgbaSetPropertyInfo = "TextTag::strikethrough-rgba-set" attrGet _ = getTextTagStrikethroughRgbaSet attrSet _ = setTextTagStrikethroughRgbaSet attrConstruct _ = constructTextTagStrikethroughRgbaSet -- VVV Prop "strikethrough-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagStrikethroughSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagStrikethroughSet obj = liftIO $ getObjectPropertyBool obj "strikethrough-set" setTextTagStrikethroughSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagStrikethroughSet obj val = liftIO $ setObjectPropertyBool obj "strikethrough-set" val constructTextTagStrikethroughSet :: Bool -> IO ([Char], GValue) constructTextTagStrikethroughSet val = constructObjectPropertyBool "strikethrough-set" val data TextTagStrikethroughSetPropertyInfo instance AttrInfo TextTagStrikethroughSetPropertyInfo where type AttrAllowedOps TextTagStrikethroughSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagStrikethroughSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagStrikethroughSetPropertyInfo = TextTagK type AttrGetType TextTagStrikethroughSetPropertyInfo = Bool type AttrLabel TextTagStrikethroughSetPropertyInfo = "TextTag::strikethrough-set" attrGet _ = getTextTagStrikethroughSet attrSet _ = setTextTagStrikethroughSet attrConstruct _ = constructTextTagStrikethroughSet -- VVV Prop "style" -- Type: TInterface "Pango" "Style" -- Flags: [PropertyReadable,PropertyWritable] getTextTagStyle :: (MonadIO m, TextTagK o) => o -> m Pango.Style getTextTagStyle obj = liftIO $ getObjectPropertyEnum obj "style" setTextTagStyle :: (MonadIO m, TextTagK o) => o -> Pango.Style -> m () setTextTagStyle obj val = liftIO $ setObjectPropertyEnum obj "style" val constructTextTagStyle :: Pango.Style -> IO ([Char], GValue) constructTextTagStyle val = constructObjectPropertyEnum "style" val data TextTagStylePropertyInfo instance AttrInfo TextTagStylePropertyInfo where type AttrAllowedOps TextTagStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagStylePropertyInfo = (~) Pango.Style type AttrBaseTypeConstraint TextTagStylePropertyInfo = TextTagK type AttrGetType TextTagStylePropertyInfo = Pango.Style type AttrLabel TextTagStylePropertyInfo = "TextTag::style" attrGet _ = getTextTagStyle attrSet _ = setTextTagStyle attrConstruct _ = constructTextTagStyle -- VVV Prop "style-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagStyleSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagStyleSet obj = liftIO $ getObjectPropertyBool obj "style-set" setTextTagStyleSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagStyleSet obj val = liftIO $ setObjectPropertyBool obj "style-set" val constructTextTagStyleSet :: Bool -> IO ([Char], GValue) constructTextTagStyleSet val = constructObjectPropertyBool "style-set" val data TextTagStyleSetPropertyInfo instance AttrInfo TextTagStyleSetPropertyInfo where type AttrAllowedOps TextTagStyleSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagStyleSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagStyleSetPropertyInfo = TextTagK type AttrGetType TextTagStyleSetPropertyInfo = Bool type AttrLabel TextTagStyleSetPropertyInfo = "TextTag::style-set" attrGet _ = getTextTagStyleSet attrSet _ = setTextTagStyleSet attrConstruct _ = constructTextTagStyleSet -- VVV Prop "tabs" -- Type: TInterface "Pango" "TabArray" -- Flags: [PropertyReadable,PropertyWritable] getTextTagTabs :: (MonadIO m, TextTagK o) => o -> m Pango.TabArray getTextTagTabs obj = liftIO $ getObjectPropertyBoxed obj "tabs" Pango.TabArray setTextTagTabs :: (MonadIO m, TextTagK o) => o -> Pango.TabArray -> m () setTextTagTabs obj val = liftIO $ setObjectPropertyBoxed obj "tabs" val constructTextTagTabs :: Pango.TabArray -> IO ([Char], GValue) constructTextTagTabs val = constructObjectPropertyBoxed "tabs" val data TextTagTabsPropertyInfo instance AttrInfo TextTagTabsPropertyInfo where type AttrAllowedOps TextTagTabsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagTabsPropertyInfo = (~) Pango.TabArray type AttrBaseTypeConstraint TextTagTabsPropertyInfo = TextTagK type AttrGetType TextTagTabsPropertyInfo = Pango.TabArray type AttrLabel TextTagTabsPropertyInfo = "TextTag::tabs" attrGet _ = getTextTagTabs attrSet _ = setTextTagTabs attrConstruct _ = constructTextTagTabs -- VVV Prop "tabs-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagTabsSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagTabsSet obj = liftIO $ getObjectPropertyBool obj "tabs-set" setTextTagTabsSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagTabsSet obj val = liftIO $ setObjectPropertyBool obj "tabs-set" val constructTextTagTabsSet :: Bool -> IO ([Char], GValue) constructTextTagTabsSet val = constructObjectPropertyBool "tabs-set" val data TextTagTabsSetPropertyInfo instance AttrInfo TextTagTabsSetPropertyInfo where type AttrAllowedOps TextTagTabsSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagTabsSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagTabsSetPropertyInfo = TextTagK type AttrGetType TextTagTabsSetPropertyInfo = Bool type AttrLabel TextTagTabsSetPropertyInfo = "TextTag::tabs-set" attrGet _ = getTextTagTabsSet attrSet _ = setTextTagTabsSet attrConstruct _ = constructTextTagTabsSet -- VVV Prop "underline" -- Type: TInterface "Pango" "Underline" -- Flags: [PropertyReadable,PropertyWritable] getTextTagUnderline :: (MonadIO m, TextTagK o) => o -> m Pango.Underline getTextTagUnderline obj = liftIO $ getObjectPropertyEnum obj "underline" setTextTagUnderline :: (MonadIO m, TextTagK o) => o -> Pango.Underline -> m () setTextTagUnderline obj val = liftIO $ setObjectPropertyEnum obj "underline" val constructTextTagUnderline :: Pango.Underline -> IO ([Char], GValue) constructTextTagUnderline val = constructObjectPropertyEnum "underline" val data TextTagUnderlinePropertyInfo instance AttrInfo TextTagUnderlinePropertyInfo where type AttrAllowedOps TextTagUnderlinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagUnderlinePropertyInfo = (~) Pango.Underline type AttrBaseTypeConstraint TextTagUnderlinePropertyInfo = TextTagK type AttrGetType TextTagUnderlinePropertyInfo = Pango.Underline type AttrLabel TextTagUnderlinePropertyInfo = "TextTag::underline" attrGet _ = getTextTagUnderline attrSet _ = setTextTagUnderline attrConstruct _ = constructTextTagUnderline -- VVV Prop "underline-rgba" -- Type: TInterface "Gdk" "RGBA" -- Flags: [PropertyReadable,PropertyWritable] getTextTagUnderlineRgba :: (MonadIO m, TextTagK o) => o -> m Gdk.RGBA getTextTagUnderlineRgba obj = liftIO $ getObjectPropertyBoxed obj "underline-rgba" Gdk.RGBA setTextTagUnderlineRgba :: (MonadIO m, TextTagK o) => o -> Gdk.RGBA -> m () setTextTagUnderlineRgba obj val = liftIO $ setObjectPropertyBoxed obj "underline-rgba" val constructTextTagUnderlineRgba :: Gdk.RGBA -> IO ([Char], GValue) constructTextTagUnderlineRgba val = constructObjectPropertyBoxed "underline-rgba" val data TextTagUnderlineRgbaPropertyInfo instance AttrInfo TextTagUnderlineRgbaPropertyInfo where type AttrAllowedOps TextTagUnderlineRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagUnderlineRgbaPropertyInfo = (~) Gdk.RGBA type AttrBaseTypeConstraint TextTagUnderlineRgbaPropertyInfo = TextTagK type AttrGetType TextTagUnderlineRgbaPropertyInfo = Gdk.RGBA type AttrLabel TextTagUnderlineRgbaPropertyInfo = "TextTag::underline-rgba" attrGet _ = getTextTagUnderlineRgba attrSet _ = setTextTagUnderlineRgba attrConstruct _ = constructTextTagUnderlineRgba -- VVV Prop "underline-rgba-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagUnderlineRgbaSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagUnderlineRgbaSet obj = liftIO $ getObjectPropertyBool obj "underline-rgba-set" setTextTagUnderlineRgbaSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagUnderlineRgbaSet obj val = liftIO $ setObjectPropertyBool obj "underline-rgba-set" val constructTextTagUnderlineRgbaSet :: Bool -> IO ([Char], GValue) constructTextTagUnderlineRgbaSet val = constructObjectPropertyBool "underline-rgba-set" val data TextTagUnderlineRgbaSetPropertyInfo instance AttrInfo TextTagUnderlineRgbaSetPropertyInfo where type AttrAllowedOps TextTagUnderlineRgbaSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagUnderlineRgbaSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagUnderlineRgbaSetPropertyInfo = TextTagK type AttrGetType TextTagUnderlineRgbaSetPropertyInfo = Bool type AttrLabel TextTagUnderlineRgbaSetPropertyInfo = "TextTag::underline-rgba-set" attrGet _ = getTextTagUnderlineRgbaSet attrSet _ = setTextTagUnderlineRgbaSet attrConstruct _ = constructTextTagUnderlineRgbaSet -- VVV Prop "underline-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagUnderlineSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagUnderlineSet obj = liftIO $ getObjectPropertyBool obj "underline-set" setTextTagUnderlineSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagUnderlineSet obj val = liftIO $ setObjectPropertyBool obj "underline-set" val constructTextTagUnderlineSet :: Bool -> IO ([Char], GValue) constructTextTagUnderlineSet val = constructObjectPropertyBool "underline-set" val data TextTagUnderlineSetPropertyInfo instance AttrInfo TextTagUnderlineSetPropertyInfo where type AttrAllowedOps TextTagUnderlineSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagUnderlineSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagUnderlineSetPropertyInfo = TextTagK type AttrGetType TextTagUnderlineSetPropertyInfo = Bool type AttrLabel TextTagUnderlineSetPropertyInfo = "TextTag::underline-set" attrGet _ = getTextTagUnderlineSet attrSet _ = setTextTagUnderlineSet attrConstruct _ = constructTextTagUnderlineSet -- VVV Prop "variant" -- Type: TInterface "Pango" "Variant" -- Flags: [PropertyReadable,PropertyWritable] getTextTagVariant :: (MonadIO m, TextTagK o) => o -> m Pango.Variant getTextTagVariant obj = liftIO $ getObjectPropertyEnum obj "variant" setTextTagVariant :: (MonadIO m, TextTagK o) => o -> Pango.Variant -> m () setTextTagVariant obj val = liftIO $ setObjectPropertyEnum obj "variant" val constructTextTagVariant :: Pango.Variant -> IO ([Char], GValue) constructTextTagVariant val = constructObjectPropertyEnum "variant" val data TextTagVariantPropertyInfo instance AttrInfo TextTagVariantPropertyInfo where type AttrAllowedOps TextTagVariantPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagVariantPropertyInfo = (~) Pango.Variant type AttrBaseTypeConstraint TextTagVariantPropertyInfo = TextTagK type AttrGetType TextTagVariantPropertyInfo = Pango.Variant type AttrLabel TextTagVariantPropertyInfo = "TextTag::variant" attrGet _ = getTextTagVariant attrSet _ = setTextTagVariant attrConstruct _ = constructTextTagVariant -- VVV Prop "variant-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagVariantSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagVariantSet obj = liftIO $ getObjectPropertyBool obj "variant-set" setTextTagVariantSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagVariantSet obj val = liftIO $ setObjectPropertyBool obj "variant-set" val constructTextTagVariantSet :: Bool -> IO ([Char], GValue) constructTextTagVariantSet val = constructObjectPropertyBool "variant-set" val data TextTagVariantSetPropertyInfo instance AttrInfo TextTagVariantSetPropertyInfo where type AttrAllowedOps TextTagVariantSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagVariantSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagVariantSetPropertyInfo = TextTagK type AttrGetType TextTagVariantSetPropertyInfo = Bool type AttrLabel TextTagVariantSetPropertyInfo = "TextTag::variant-set" attrGet _ = getTextTagVariantSet attrSet _ = setTextTagVariantSet attrConstruct _ = constructTextTagVariantSet -- VVV Prop "weight" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextTagWeight :: (MonadIO m, TextTagK o) => o -> m Int32 getTextTagWeight obj = liftIO $ getObjectPropertyCInt obj "weight" setTextTagWeight :: (MonadIO m, TextTagK o) => o -> Int32 -> m () setTextTagWeight obj val = liftIO $ setObjectPropertyCInt obj "weight" val constructTextTagWeight :: Int32 -> IO ([Char], GValue) constructTextTagWeight val = constructObjectPropertyCInt "weight" val data TextTagWeightPropertyInfo instance AttrInfo TextTagWeightPropertyInfo where type AttrAllowedOps TextTagWeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagWeightPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextTagWeightPropertyInfo = TextTagK type AttrGetType TextTagWeightPropertyInfo = Int32 type AttrLabel TextTagWeightPropertyInfo = "TextTag::weight" attrGet _ = getTextTagWeight attrSet _ = setTextTagWeight attrConstruct _ = constructTextTagWeight -- VVV Prop "weight-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagWeightSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagWeightSet obj = liftIO $ getObjectPropertyBool obj "weight-set" setTextTagWeightSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagWeightSet obj val = liftIO $ setObjectPropertyBool obj "weight-set" val constructTextTagWeightSet :: Bool -> IO ([Char], GValue) constructTextTagWeightSet val = constructObjectPropertyBool "weight-set" val data TextTagWeightSetPropertyInfo instance AttrInfo TextTagWeightSetPropertyInfo where type AttrAllowedOps TextTagWeightSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagWeightSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagWeightSetPropertyInfo = TextTagK type AttrGetType TextTagWeightSetPropertyInfo = Bool type AttrLabel TextTagWeightSetPropertyInfo = "TextTag::weight-set" attrGet _ = getTextTagWeightSet attrSet _ = setTextTagWeightSet attrConstruct _ = constructTextTagWeightSet -- VVV Prop "wrap-mode" -- Type: TInterface "Gtk" "WrapMode" -- Flags: [PropertyReadable,PropertyWritable] getTextTagWrapMode :: (MonadIO m, TextTagK o) => o -> m WrapMode getTextTagWrapMode obj = liftIO $ getObjectPropertyEnum obj "wrap-mode" setTextTagWrapMode :: (MonadIO m, TextTagK o) => o -> WrapMode -> m () setTextTagWrapMode obj val = liftIO $ setObjectPropertyEnum obj "wrap-mode" val constructTextTagWrapMode :: WrapMode -> IO ([Char], GValue) constructTextTagWrapMode val = constructObjectPropertyEnum "wrap-mode" val data TextTagWrapModePropertyInfo instance AttrInfo TextTagWrapModePropertyInfo where type AttrAllowedOps TextTagWrapModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagWrapModePropertyInfo = (~) WrapMode type AttrBaseTypeConstraint TextTagWrapModePropertyInfo = TextTagK type AttrGetType TextTagWrapModePropertyInfo = WrapMode type AttrLabel TextTagWrapModePropertyInfo = "TextTag::wrap-mode" attrGet _ = getTextTagWrapMode attrSet _ = setTextTagWrapMode attrConstruct _ = constructTextTagWrapMode -- VVV Prop "wrap-mode-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextTagWrapModeSet :: (MonadIO m, TextTagK o) => o -> m Bool getTextTagWrapModeSet obj = liftIO $ getObjectPropertyBool obj "wrap-mode-set" setTextTagWrapModeSet :: (MonadIO m, TextTagK o) => o -> Bool -> m () setTextTagWrapModeSet obj val = liftIO $ setObjectPropertyBool obj "wrap-mode-set" val constructTextTagWrapModeSet :: Bool -> IO ([Char], GValue) constructTextTagWrapModeSet val = constructObjectPropertyBool "wrap-mode-set" val data TextTagWrapModeSetPropertyInfo instance AttrInfo TextTagWrapModeSetPropertyInfo where type AttrAllowedOps TextTagWrapModeSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextTagWrapModeSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextTagWrapModeSetPropertyInfo = TextTagK type AttrGetType TextTagWrapModeSetPropertyInfo = Bool type AttrLabel TextTagWrapModeSetPropertyInfo = "TextTag::wrap-mode-set" attrGet _ = getTextTagWrapModeSet attrSet _ = setTextTagWrapModeSet attrConstruct _ = constructTextTagWrapModeSet type instance AttributeList TextTag = '[ '("accumulative-margin", TextTagAccumulativeMarginPropertyInfo), '("background", TextTagBackgroundPropertyInfo), '("background-full-height", TextTagBackgroundFullHeightPropertyInfo), '("background-full-height-set", TextTagBackgroundFullHeightSetPropertyInfo), '("background-gdk", TextTagBackgroundGdkPropertyInfo), '("background-rgba", TextTagBackgroundRgbaPropertyInfo), '("background-set", TextTagBackgroundSetPropertyInfo), '("direction", TextTagDirectionPropertyInfo), '("editable", TextTagEditablePropertyInfo), '("editable-set", TextTagEditableSetPropertyInfo), '("fallback", TextTagFallbackPropertyInfo), '("fallback-set", TextTagFallbackSetPropertyInfo), '("family", TextTagFamilyPropertyInfo), '("family-set", TextTagFamilySetPropertyInfo), '("font", TextTagFontPropertyInfo), '("font-desc", TextTagFontDescPropertyInfo), '("font-features", TextTagFontFeaturesPropertyInfo), '("font-features-set", TextTagFontFeaturesSetPropertyInfo), '("foreground", TextTagForegroundPropertyInfo), '("foreground-gdk", TextTagForegroundGdkPropertyInfo), '("foreground-rgba", TextTagForegroundRgbaPropertyInfo), '("foreground-set", TextTagForegroundSetPropertyInfo), '("indent", TextTagIndentPropertyInfo), '("indent-set", TextTagIndentSetPropertyInfo), '("invisible", TextTagInvisiblePropertyInfo), '("invisible-set", TextTagInvisibleSetPropertyInfo), '("justification", TextTagJustificationPropertyInfo), '("justification-set", TextTagJustificationSetPropertyInfo), '("language", TextTagLanguagePropertyInfo), '("language-set", TextTagLanguageSetPropertyInfo), '("left-margin", TextTagLeftMarginPropertyInfo), '("left-margin-set", TextTagLeftMarginSetPropertyInfo), '("letter-spacing", TextTagLetterSpacingPropertyInfo), '("letter-spacing-set", TextTagLetterSpacingSetPropertyInfo), '("name", TextTagNamePropertyInfo), '("paragraph-background", TextTagParagraphBackgroundPropertyInfo), '("paragraph-background-gdk", TextTagParagraphBackgroundGdkPropertyInfo), '("paragraph-background-rgba", TextTagParagraphBackgroundRgbaPropertyInfo), '("paragraph-background-set", TextTagParagraphBackgroundSetPropertyInfo), '("pixels-above-lines", TextTagPixelsAboveLinesPropertyInfo), '("pixels-above-lines-set", TextTagPixelsAboveLinesSetPropertyInfo), '("pixels-below-lines", TextTagPixelsBelowLinesPropertyInfo), '("pixels-below-lines-set", TextTagPixelsBelowLinesSetPropertyInfo), '("pixels-inside-wrap", TextTagPixelsInsideWrapPropertyInfo), '("pixels-inside-wrap-set", TextTagPixelsInsideWrapSetPropertyInfo), '("right-margin", TextTagRightMarginPropertyInfo), '("right-margin-set", TextTagRightMarginSetPropertyInfo), '("rise", TextTagRisePropertyInfo), '("rise-set", TextTagRiseSetPropertyInfo), '("scale", TextTagScalePropertyInfo), '("scale-set", TextTagScaleSetPropertyInfo), '("size", TextTagSizePropertyInfo), '("size-points", TextTagSizePointsPropertyInfo), '("size-set", TextTagSizeSetPropertyInfo), '("stretch", TextTagStretchPropertyInfo), '("stretch-set", TextTagStretchSetPropertyInfo), '("strikethrough", TextTagStrikethroughPropertyInfo), '("strikethrough-rgba", TextTagStrikethroughRgbaPropertyInfo), '("strikethrough-rgba-set", TextTagStrikethroughRgbaSetPropertyInfo), '("strikethrough-set", TextTagStrikethroughSetPropertyInfo), '("style", TextTagStylePropertyInfo), '("style-set", TextTagStyleSetPropertyInfo), '("tabs", TextTagTabsPropertyInfo), '("tabs-set", TextTagTabsSetPropertyInfo), '("underline", TextTagUnderlinePropertyInfo), '("underline-rgba", TextTagUnderlineRgbaPropertyInfo), '("underline-rgba-set", TextTagUnderlineRgbaSetPropertyInfo), '("underline-set", TextTagUnderlineSetPropertyInfo), '("variant", TextTagVariantPropertyInfo), '("variant-set", TextTagVariantSetPropertyInfo), '("weight", TextTagWeightPropertyInfo), '("weight-set", TextTagWeightSetPropertyInfo), '("wrap-mode", TextTagWrapModePropertyInfo), '("wrap-mode-set", TextTagWrapModeSetPropertyInfo)] type instance AttributeList TextTagTable = '[ ] -- VVV Prop "accepts-tab" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextViewAcceptsTab :: (MonadIO m, TextViewK o) => o -> m Bool getTextViewAcceptsTab obj = liftIO $ getObjectPropertyBool obj "accepts-tab" setTextViewAcceptsTab :: (MonadIO m, TextViewK o) => o -> Bool -> m () setTextViewAcceptsTab obj val = liftIO $ setObjectPropertyBool obj "accepts-tab" val constructTextViewAcceptsTab :: Bool -> IO ([Char], GValue) constructTextViewAcceptsTab val = constructObjectPropertyBool "accepts-tab" val data TextViewAcceptsTabPropertyInfo instance AttrInfo TextViewAcceptsTabPropertyInfo where type AttrAllowedOps TextViewAcceptsTabPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewAcceptsTabPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextViewAcceptsTabPropertyInfo = TextViewK type AttrGetType TextViewAcceptsTabPropertyInfo = Bool type AttrLabel TextViewAcceptsTabPropertyInfo = "TextView::accepts-tab" attrGet _ = getTextViewAcceptsTab attrSet _ = setTextViewAcceptsTab attrConstruct _ = constructTextViewAcceptsTab -- VVV Prop "bottom-margin" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextViewBottomMargin :: (MonadIO m, TextViewK o) => o -> m Int32 getTextViewBottomMargin obj = liftIO $ getObjectPropertyCInt obj "bottom-margin" setTextViewBottomMargin :: (MonadIO m, TextViewK o) => o -> Int32 -> m () setTextViewBottomMargin obj val = liftIO $ setObjectPropertyCInt obj "bottom-margin" val constructTextViewBottomMargin :: Int32 -> IO ([Char], GValue) constructTextViewBottomMargin val = constructObjectPropertyCInt "bottom-margin" val data TextViewBottomMarginPropertyInfo instance AttrInfo TextViewBottomMarginPropertyInfo where type AttrAllowedOps TextViewBottomMarginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewBottomMarginPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextViewBottomMarginPropertyInfo = TextViewK type AttrGetType TextViewBottomMarginPropertyInfo = Int32 type AttrLabel TextViewBottomMarginPropertyInfo = "TextView::bottom-margin" attrGet _ = getTextViewBottomMargin attrSet _ = setTextViewBottomMargin attrConstruct _ = constructTextViewBottomMargin -- VVV Prop "buffer" -- Type: TInterface "Gtk" "TextBuffer" -- Flags: [PropertyReadable,PropertyWritable] getTextViewBuffer :: (MonadIO m, TextViewK o) => o -> m TextBuffer getTextViewBuffer obj = liftIO $ getObjectPropertyObject obj "buffer" TextBuffer setTextViewBuffer :: (MonadIO m, TextViewK o, TextBufferK a) => o -> a -> m () setTextViewBuffer obj val = liftIO $ setObjectPropertyObject obj "buffer" val constructTextViewBuffer :: (TextBufferK a) => a -> IO ([Char], GValue) constructTextViewBuffer val = constructObjectPropertyObject "buffer" val data TextViewBufferPropertyInfo instance AttrInfo TextViewBufferPropertyInfo where type AttrAllowedOps TextViewBufferPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewBufferPropertyInfo = TextBufferK type AttrBaseTypeConstraint TextViewBufferPropertyInfo = TextViewK type AttrGetType TextViewBufferPropertyInfo = TextBuffer type AttrLabel TextViewBufferPropertyInfo = "TextView::buffer" attrGet _ = getTextViewBuffer attrSet _ = setTextViewBuffer attrConstruct _ = constructTextViewBuffer -- VVV Prop "cursor-visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextViewCursorVisible :: (MonadIO m, TextViewK o) => o -> m Bool getTextViewCursorVisible obj = liftIO $ getObjectPropertyBool obj "cursor-visible" setTextViewCursorVisible :: (MonadIO m, TextViewK o) => o -> Bool -> m () setTextViewCursorVisible obj val = liftIO $ setObjectPropertyBool obj "cursor-visible" val constructTextViewCursorVisible :: Bool -> IO ([Char], GValue) constructTextViewCursorVisible val = constructObjectPropertyBool "cursor-visible" val data TextViewCursorVisiblePropertyInfo instance AttrInfo TextViewCursorVisiblePropertyInfo where type AttrAllowedOps TextViewCursorVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewCursorVisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint TextViewCursorVisiblePropertyInfo = TextViewK type AttrGetType TextViewCursorVisiblePropertyInfo = Bool type AttrLabel TextViewCursorVisiblePropertyInfo = "TextView::cursor-visible" attrGet _ = getTextViewCursorVisible attrSet _ = setTextViewCursorVisible attrConstruct _ = constructTextViewCursorVisible -- VVV Prop "editable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextViewEditable :: (MonadIO m, TextViewK o) => o -> m Bool getTextViewEditable obj = liftIO $ getObjectPropertyBool obj "editable" setTextViewEditable :: (MonadIO m, TextViewK o) => o -> Bool -> m () setTextViewEditable obj val = liftIO $ setObjectPropertyBool obj "editable" val constructTextViewEditable :: Bool -> IO ([Char], GValue) constructTextViewEditable val = constructObjectPropertyBool "editable" val data TextViewEditablePropertyInfo instance AttrInfo TextViewEditablePropertyInfo where type AttrAllowedOps TextViewEditablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewEditablePropertyInfo = (~) Bool type AttrBaseTypeConstraint TextViewEditablePropertyInfo = TextViewK type AttrGetType TextViewEditablePropertyInfo = Bool type AttrLabel TextViewEditablePropertyInfo = "TextView::editable" attrGet _ = getTextViewEditable attrSet _ = setTextViewEditable attrConstruct _ = constructTextViewEditable -- VVV Prop "im-module" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getTextViewImModule :: (MonadIO m, TextViewK o) => o -> m T.Text getTextViewImModule obj = liftIO $ getObjectPropertyString obj "im-module" setTextViewImModule :: (MonadIO m, TextViewK o) => o -> T.Text -> m () setTextViewImModule obj val = liftIO $ setObjectPropertyString obj "im-module" val constructTextViewImModule :: T.Text -> IO ([Char], GValue) constructTextViewImModule val = constructObjectPropertyString "im-module" val data TextViewImModulePropertyInfo instance AttrInfo TextViewImModulePropertyInfo where type AttrAllowedOps TextViewImModulePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewImModulePropertyInfo = (~) T.Text type AttrBaseTypeConstraint TextViewImModulePropertyInfo = TextViewK type AttrGetType TextViewImModulePropertyInfo = T.Text type AttrLabel TextViewImModulePropertyInfo = "TextView::im-module" attrGet _ = getTextViewImModule attrSet _ = setTextViewImModule attrConstruct _ = constructTextViewImModule -- VVV Prop "indent" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextViewIndent :: (MonadIO m, TextViewK o) => o -> m Int32 getTextViewIndent obj = liftIO $ getObjectPropertyCInt obj "indent" setTextViewIndent :: (MonadIO m, TextViewK o) => o -> Int32 -> m () setTextViewIndent obj val = liftIO $ setObjectPropertyCInt obj "indent" val constructTextViewIndent :: Int32 -> IO ([Char], GValue) constructTextViewIndent val = constructObjectPropertyCInt "indent" val data TextViewIndentPropertyInfo instance AttrInfo TextViewIndentPropertyInfo where type AttrAllowedOps TextViewIndentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewIndentPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextViewIndentPropertyInfo = TextViewK type AttrGetType TextViewIndentPropertyInfo = Int32 type AttrLabel TextViewIndentPropertyInfo = "TextView::indent" attrGet _ = getTextViewIndent attrSet _ = setTextViewIndent attrConstruct _ = constructTextViewIndent -- VVV Prop "input-hints" -- Type: TInterface "Gtk" "InputHints" -- Flags: [PropertyReadable,PropertyWritable] getTextViewInputHints :: (MonadIO m, TextViewK o) => o -> m [InputHints] getTextViewInputHints obj = liftIO $ getObjectPropertyFlags obj "input-hints" setTextViewInputHints :: (MonadIO m, TextViewK o) => o -> [InputHints] -> m () setTextViewInputHints obj val = liftIO $ setObjectPropertyFlags obj "input-hints" val constructTextViewInputHints :: [InputHints] -> IO ([Char], GValue) constructTextViewInputHints val = constructObjectPropertyFlags "input-hints" val data TextViewInputHintsPropertyInfo instance AttrInfo TextViewInputHintsPropertyInfo where type AttrAllowedOps TextViewInputHintsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewInputHintsPropertyInfo = (~) [InputHints] type AttrBaseTypeConstraint TextViewInputHintsPropertyInfo = TextViewK type AttrGetType TextViewInputHintsPropertyInfo = [InputHints] type AttrLabel TextViewInputHintsPropertyInfo = "TextView::input-hints" attrGet _ = getTextViewInputHints attrSet _ = setTextViewInputHints attrConstruct _ = constructTextViewInputHints -- VVV Prop "input-purpose" -- Type: TInterface "Gtk" "InputPurpose" -- Flags: [PropertyReadable,PropertyWritable] getTextViewInputPurpose :: (MonadIO m, TextViewK o) => o -> m InputPurpose getTextViewInputPurpose obj = liftIO $ getObjectPropertyEnum obj "input-purpose" setTextViewInputPurpose :: (MonadIO m, TextViewK o) => o -> InputPurpose -> m () setTextViewInputPurpose obj val = liftIO $ setObjectPropertyEnum obj "input-purpose" val constructTextViewInputPurpose :: InputPurpose -> IO ([Char], GValue) constructTextViewInputPurpose val = constructObjectPropertyEnum "input-purpose" val data TextViewInputPurposePropertyInfo instance AttrInfo TextViewInputPurposePropertyInfo where type AttrAllowedOps TextViewInputPurposePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewInputPurposePropertyInfo = (~) InputPurpose type AttrBaseTypeConstraint TextViewInputPurposePropertyInfo = TextViewK type AttrGetType TextViewInputPurposePropertyInfo = InputPurpose type AttrLabel TextViewInputPurposePropertyInfo = "TextView::input-purpose" attrGet _ = getTextViewInputPurpose attrSet _ = setTextViewInputPurpose attrConstruct _ = constructTextViewInputPurpose -- VVV Prop "justification" -- Type: TInterface "Gtk" "Justification" -- Flags: [PropertyReadable,PropertyWritable] getTextViewJustification :: (MonadIO m, TextViewK o) => o -> m Justification getTextViewJustification obj = liftIO $ getObjectPropertyEnum obj "justification" setTextViewJustification :: (MonadIO m, TextViewK o) => o -> Justification -> m () setTextViewJustification obj val = liftIO $ setObjectPropertyEnum obj "justification" val constructTextViewJustification :: Justification -> IO ([Char], GValue) constructTextViewJustification val = constructObjectPropertyEnum "justification" val data TextViewJustificationPropertyInfo instance AttrInfo TextViewJustificationPropertyInfo where type AttrAllowedOps TextViewJustificationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewJustificationPropertyInfo = (~) Justification type AttrBaseTypeConstraint TextViewJustificationPropertyInfo = TextViewK type AttrGetType TextViewJustificationPropertyInfo = Justification type AttrLabel TextViewJustificationPropertyInfo = "TextView::justification" attrGet _ = getTextViewJustification attrSet _ = setTextViewJustification attrConstruct _ = constructTextViewJustification -- VVV Prop "left-margin" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextViewLeftMargin :: (MonadIO m, TextViewK o) => o -> m Int32 getTextViewLeftMargin obj = liftIO $ getObjectPropertyCInt obj "left-margin" setTextViewLeftMargin :: (MonadIO m, TextViewK o) => o -> Int32 -> m () setTextViewLeftMargin obj val = liftIO $ setObjectPropertyCInt obj "left-margin" val constructTextViewLeftMargin :: Int32 -> IO ([Char], GValue) constructTextViewLeftMargin val = constructObjectPropertyCInt "left-margin" val data TextViewLeftMarginPropertyInfo instance AttrInfo TextViewLeftMarginPropertyInfo where type AttrAllowedOps TextViewLeftMarginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewLeftMarginPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextViewLeftMarginPropertyInfo = TextViewK type AttrGetType TextViewLeftMarginPropertyInfo = Int32 type AttrLabel TextViewLeftMarginPropertyInfo = "TextView::left-margin" attrGet _ = getTextViewLeftMargin attrSet _ = setTextViewLeftMargin attrConstruct _ = constructTextViewLeftMargin -- VVV Prop "monospace" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextViewMonospace :: (MonadIO m, TextViewK o) => o -> m Bool getTextViewMonospace obj = liftIO $ getObjectPropertyBool obj "monospace" setTextViewMonospace :: (MonadIO m, TextViewK o) => o -> Bool -> m () setTextViewMonospace obj val = liftIO $ setObjectPropertyBool obj "monospace" val constructTextViewMonospace :: Bool -> IO ([Char], GValue) constructTextViewMonospace val = constructObjectPropertyBool "monospace" val data TextViewMonospacePropertyInfo instance AttrInfo TextViewMonospacePropertyInfo where type AttrAllowedOps TextViewMonospacePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewMonospacePropertyInfo = (~) Bool type AttrBaseTypeConstraint TextViewMonospacePropertyInfo = TextViewK type AttrGetType TextViewMonospacePropertyInfo = Bool type AttrLabel TextViewMonospacePropertyInfo = "TextView::monospace" attrGet _ = getTextViewMonospace attrSet _ = setTextViewMonospace attrConstruct _ = constructTextViewMonospace -- VVV Prop "overwrite" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextViewOverwrite :: (MonadIO m, TextViewK o) => o -> m Bool getTextViewOverwrite obj = liftIO $ getObjectPropertyBool obj "overwrite" setTextViewOverwrite :: (MonadIO m, TextViewK o) => o -> Bool -> m () setTextViewOverwrite obj val = liftIO $ setObjectPropertyBool obj "overwrite" val constructTextViewOverwrite :: Bool -> IO ([Char], GValue) constructTextViewOverwrite val = constructObjectPropertyBool "overwrite" val data TextViewOverwritePropertyInfo instance AttrInfo TextViewOverwritePropertyInfo where type AttrAllowedOps TextViewOverwritePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewOverwritePropertyInfo = (~) Bool type AttrBaseTypeConstraint TextViewOverwritePropertyInfo = TextViewK type AttrGetType TextViewOverwritePropertyInfo = Bool type AttrLabel TextViewOverwritePropertyInfo = "TextView::overwrite" attrGet _ = getTextViewOverwrite attrSet _ = setTextViewOverwrite attrConstruct _ = constructTextViewOverwrite -- VVV Prop "pixels-above-lines" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextViewPixelsAboveLines :: (MonadIO m, TextViewK o) => o -> m Int32 getTextViewPixelsAboveLines obj = liftIO $ getObjectPropertyCInt obj "pixels-above-lines" setTextViewPixelsAboveLines :: (MonadIO m, TextViewK o) => o -> Int32 -> m () setTextViewPixelsAboveLines obj val = liftIO $ setObjectPropertyCInt obj "pixels-above-lines" val constructTextViewPixelsAboveLines :: Int32 -> IO ([Char], GValue) constructTextViewPixelsAboveLines val = constructObjectPropertyCInt "pixels-above-lines" val data TextViewPixelsAboveLinesPropertyInfo instance AttrInfo TextViewPixelsAboveLinesPropertyInfo where type AttrAllowedOps TextViewPixelsAboveLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewPixelsAboveLinesPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextViewPixelsAboveLinesPropertyInfo = TextViewK type AttrGetType TextViewPixelsAboveLinesPropertyInfo = Int32 type AttrLabel TextViewPixelsAboveLinesPropertyInfo = "TextView::pixels-above-lines" attrGet _ = getTextViewPixelsAboveLines attrSet _ = setTextViewPixelsAboveLines attrConstruct _ = constructTextViewPixelsAboveLines -- VVV Prop "pixels-below-lines" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextViewPixelsBelowLines :: (MonadIO m, TextViewK o) => o -> m Int32 getTextViewPixelsBelowLines obj = liftIO $ getObjectPropertyCInt obj "pixels-below-lines" setTextViewPixelsBelowLines :: (MonadIO m, TextViewK o) => o -> Int32 -> m () setTextViewPixelsBelowLines obj val = liftIO $ setObjectPropertyCInt obj "pixels-below-lines" val constructTextViewPixelsBelowLines :: Int32 -> IO ([Char], GValue) constructTextViewPixelsBelowLines val = constructObjectPropertyCInt "pixels-below-lines" val data TextViewPixelsBelowLinesPropertyInfo instance AttrInfo TextViewPixelsBelowLinesPropertyInfo where type AttrAllowedOps TextViewPixelsBelowLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewPixelsBelowLinesPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextViewPixelsBelowLinesPropertyInfo = TextViewK type AttrGetType TextViewPixelsBelowLinesPropertyInfo = Int32 type AttrLabel TextViewPixelsBelowLinesPropertyInfo = "TextView::pixels-below-lines" attrGet _ = getTextViewPixelsBelowLines attrSet _ = setTextViewPixelsBelowLines attrConstruct _ = constructTextViewPixelsBelowLines -- VVV Prop "pixels-inside-wrap" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextViewPixelsInsideWrap :: (MonadIO m, TextViewK o) => o -> m Int32 getTextViewPixelsInsideWrap obj = liftIO $ getObjectPropertyCInt obj "pixels-inside-wrap" setTextViewPixelsInsideWrap :: (MonadIO m, TextViewK o) => o -> Int32 -> m () setTextViewPixelsInsideWrap obj val = liftIO $ setObjectPropertyCInt obj "pixels-inside-wrap" val constructTextViewPixelsInsideWrap :: Int32 -> IO ([Char], GValue) constructTextViewPixelsInsideWrap val = constructObjectPropertyCInt "pixels-inside-wrap" val data TextViewPixelsInsideWrapPropertyInfo instance AttrInfo TextViewPixelsInsideWrapPropertyInfo where type AttrAllowedOps TextViewPixelsInsideWrapPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewPixelsInsideWrapPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextViewPixelsInsideWrapPropertyInfo = TextViewK type AttrGetType TextViewPixelsInsideWrapPropertyInfo = Int32 type AttrLabel TextViewPixelsInsideWrapPropertyInfo = "TextView::pixels-inside-wrap" attrGet _ = getTextViewPixelsInsideWrap attrSet _ = setTextViewPixelsInsideWrap attrConstruct _ = constructTextViewPixelsInsideWrap -- VVV Prop "populate-all" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTextViewPopulateAll :: (MonadIO m, TextViewK o) => o -> m Bool getTextViewPopulateAll obj = liftIO $ getObjectPropertyBool obj "populate-all" setTextViewPopulateAll :: (MonadIO m, TextViewK o) => o -> Bool -> m () setTextViewPopulateAll obj val = liftIO $ setObjectPropertyBool obj "populate-all" val constructTextViewPopulateAll :: Bool -> IO ([Char], GValue) constructTextViewPopulateAll val = constructObjectPropertyBool "populate-all" val data TextViewPopulateAllPropertyInfo instance AttrInfo TextViewPopulateAllPropertyInfo where type AttrAllowedOps TextViewPopulateAllPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewPopulateAllPropertyInfo = (~) Bool type AttrBaseTypeConstraint TextViewPopulateAllPropertyInfo = TextViewK type AttrGetType TextViewPopulateAllPropertyInfo = Bool type AttrLabel TextViewPopulateAllPropertyInfo = "TextView::populate-all" attrGet _ = getTextViewPopulateAll attrSet _ = setTextViewPopulateAll attrConstruct _ = constructTextViewPopulateAll -- VVV Prop "right-margin" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextViewRightMargin :: (MonadIO m, TextViewK o) => o -> m Int32 getTextViewRightMargin obj = liftIO $ getObjectPropertyCInt obj "right-margin" setTextViewRightMargin :: (MonadIO m, TextViewK o) => o -> Int32 -> m () setTextViewRightMargin obj val = liftIO $ setObjectPropertyCInt obj "right-margin" val constructTextViewRightMargin :: Int32 -> IO ([Char], GValue) constructTextViewRightMargin val = constructObjectPropertyCInt "right-margin" val data TextViewRightMarginPropertyInfo instance AttrInfo TextViewRightMarginPropertyInfo where type AttrAllowedOps TextViewRightMarginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewRightMarginPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextViewRightMarginPropertyInfo = TextViewK type AttrGetType TextViewRightMarginPropertyInfo = Int32 type AttrLabel TextViewRightMarginPropertyInfo = "TextView::right-margin" attrGet _ = getTextViewRightMargin attrSet _ = setTextViewRightMargin attrConstruct _ = constructTextViewRightMargin -- VVV Prop "tabs" -- Type: TInterface "Pango" "TabArray" -- Flags: [PropertyReadable,PropertyWritable] getTextViewTabs :: (MonadIO m, TextViewK o) => o -> m Pango.TabArray getTextViewTabs obj = liftIO $ getObjectPropertyBoxed obj "tabs" Pango.TabArray setTextViewTabs :: (MonadIO m, TextViewK o) => o -> Pango.TabArray -> m () setTextViewTabs obj val = liftIO $ setObjectPropertyBoxed obj "tabs" val constructTextViewTabs :: Pango.TabArray -> IO ([Char], GValue) constructTextViewTabs val = constructObjectPropertyBoxed "tabs" val data TextViewTabsPropertyInfo instance AttrInfo TextViewTabsPropertyInfo where type AttrAllowedOps TextViewTabsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewTabsPropertyInfo = (~) Pango.TabArray type AttrBaseTypeConstraint TextViewTabsPropertyInfo = TextViewK type AttrGetType TextViewTabsPropertyInfo = Pango.TabArray type AttrLabel TextViewTabsPropertyInfo = "TextView::tabs" attrGet _ = getTextViewTabs attrSet _ = setTextViewTabs attrConstruct _ = constructTextViewTabs -- VVV Prop "top-margin" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTextViewTopMargin :: (MonadIO m, TextViewK o) => o -> m Int32 getTextViewTopMargin obj = liftIO $ getObjectPropertyCInt obj "top-margin" setTextViewTopMargin :: (MonadIO m, TextViewK o) => o -> Int32 -> m () setTextViewTopMargin obj val = liftIO $ setObjectPropertyCInt obj "top-margin" val constructTextViewTopMargin :: Int32 -> IO ([Char], GValue) constructTextViewTopMargin val = constructObjectPropertyCInt "top-margin" val data TextViewTopMarginPropertyInfo instance AttrInfo TextViewTopMarginPropertyInfo where type AttrAllowedOps TextViewTopMarginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewTopMarginPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TextViewTopMarginPropertyInfo = TextViewK type AttrGetType TextViewTopMarginPropertyInfo = Int32 type AttrLabel TextViewTopMarginPropertyInfo = "TextView::top-margin" attrGet _ = getTextViewTopMargin attrSet _ = setTextViewTopMargin attrConstruct _ = constructTextViewTopMargin -- VVV Prop "wrap-mode" -- Type: TInterface "Gtk" "WrapMode" -- Flags: [PropertyReadable,PropertyWritable] getTextViewWrapMode :: (MonadIO m, TextViewK o) => o -> m WrapMode getTextViewWrapMode obj = liftIO $ getObjectPropertyEnum obj "wrap-mode" setTextViewWrapMode :: (MonadIO m, TextViewK o) => o -> WrapMode -> m () setTextViewWrapMode obj val = liftIO $ setObjectPropertyEnum obj "wrap-mode" val constructTextViewWrapMode :: WrapMode -> IO ([Char], GValue) constructTextViewWrapMode val = constructObjectPropertyEnum "wrap-mode" val data TextViewWrapModePropertyInfo instance AttrInfo TextViewWrapModePropertyInfo where type AttrAllowedOps TextViewWrapModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TextViewWrapModePropertyInfo = (~) WrapMode type AttrBaseTypeConstraint TextViewWrapModePropertyInfo = TextViewK type AttrGetType TextViewWrapModePropertyInfo = WrapMode type AttrLabel TextViewWrapModePropertyInfo = "TextView::wrap-mode" attrGet _ = getTextViewWrapMode attrSet _ = setTextViewWrapMode attrConstruct _ = constructTextViewWrapMode type instance AttributeList TextView = '[ '("accepts-tab", TextViewAcceptsTabPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("bottom-margin", TextViewBottomMarginPropertyInfo), '("buffer", TextViewBufferPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("cursor-visible", TextViewCursorVisiblePropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("editable", TextViewEditablePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("hadjustment", ScrollableHadjustmentPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hscroll-policy", ScrollableHscrollPolicyPropertyInfo), '("im-module", TextViewImModulePropertyInfo), '("indent", TextViewIndentPropertyInfo), '("input-hints", TextViewInputHintsPropertyInfo), '("input-purpose", TextViewInputPurposePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("justification", TextViewJustificationPropertyInfo), '("left-margin", TextViewLeftMarginPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("monospace", TextViewMonospacePropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("overwrite", TextViewOverwritePropertyInfo), '("parent", WidgetParentPropertyInfo), '("pixels-above-lines", TextViewPixelsAboveLinesPropertyInfo), '("pixels-below-lines", TextViewPixelsBelowLinesPropertyInfo), '("pixels-inside-wrap", TextViewPixelsInsideWrapPropertyInfo), '("populate-all", TextViewPopulateAllPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("right-margin", TextViewRightMarginPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tabs", TextViewTabsPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("top-margin", TextViewTopMarginPropertyInfo), '("vadjustment", ScrollableVadjustmentPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("vscroll-policy", ScrollableVscrollPolicyPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("wrap-mode", TextViewWrapModePropertyInfo)] type instance AttributeList TextViewAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getThemingEngineName :: (MonadIO m, ThemingEngineK o) => o -> m T.Text getThemingEngineName obj = liftIO $ getObjectPropertyString obj "name" constructThemingEngineName :: T.Text -> IO ([Char], GValue) constructThemingEngineName val = constructObjectPropertyString "name" val data ThemingEngineNamePropertyInfo instance AttrInfo ThemingEngineNamePropertyInfo where type AttrAllowedOps ThemingEngineNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ThemingEngineNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ThemingEngineNamePropertyInfo = ThemingEngineK type AttrGetType ThemingEngineNamePropertyInfo = T.Text type AttrLabel ThemingEngineNamePropertyInfo = "ThemingEngine::name" attrGet _ = getThemingEngineName attrSet _ = undefined attrConstruct _ = constructThemingEngineName type instance AttributeList ThemingEngine = '[ '("name", ThemingEngineNamePropertyInfo)] -- VVV Prop "active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToggleActionActive :: (MonadIO m, ToggleActionK o) => o -> m Bool getToggleActionActive obj = liftIO $ getObjectPropertyBool obj "active" setToggleActionActive :: (MonadIO m, ToggleActionK o) => o -> Bool -> m () setToggleActionActive obj val = liftIO $ setObjectPropertyBool obj "active" val constructToggleActionActive :: Bool -> IO ([Char], GValue) constructToggleActionActive val = constructObjectPropertyBool "active" val data ToggleActionActivePropertyInfo instance AttrInfo ToggleActionActivePropertyInfo where type AttrAllowedOps ToggleActionActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToggleActionActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint ToggleActionActivePropertyInfo = ToggleActionK type AttrGetType ToggleActionActivePropertyInfo = Bool type AttrLabel ToggleActionActivePropertyInfo = "ToggleAction::active" attrGet _ = getToggleActionActive attrSet _ = setToggleActionActive attrConstruct _ = constructToggleActionActive -- VVV Prop "draw-as-radio" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToggleActionDrawAsRadio :: (MonadIO m, ToggleActionK o) => o -> m Bool getToggleActionDrawAsRadio obj = liftIO $ getObjectPropertyBool obj "draw-as-radio" setToggleActionDrawAsRadio :: (MonadIO m, ToggleActionK o) => o -> Bool -> m () setToggleActionDrawAsRadio obj val = liftIO $ setObjectPropertyBool obj "draw-as-radio" val constructToggleActionDrawAsRadio :: Bool -> IO ([Char], GValue) constructToggleActionDrawAsRadio val = constructObjectPropertyBool "draw-as-radio" val data ToggleActionDrawAsRadioPropertyInfo instance AttrInfo ToggleActionDrawAsRadioPropertyInfo where type AttrAllowedOps ToggleActionDrawAsRadioPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToggleActionDrawAsRadioPropertyInfo = (~) Bool type AttrBaseTypeConstraint ToggleActionDrawAsRadioPropertyInfo = ToggleActionK type AttrGetType ToggleActionDrawAsRadioPropertyInfo = Bool type AttrLabel ToggleActionDrawAsRadioPropertyInfo = "ToggleAction::draw-as-radio" attrGet _ = getToggleActionDrawAsRadio attrSet _ = setToggleActionDrawAsRadio attrConstruct _ = constructToggleActionDrawAsRadio type instance AttributeList ToggleAction = '[ '("action-group", ActionActionGroupPropertyInfo), '("active", ToggleActionActivePropertyInfo), '("always-show-image", ActionAlwaysShowImagePropertyInfo), '("draw-as-radio", ToggleActionDrawAsRadioPropertyInfo), '("gicon", ActionGiconPropertyInfo), '("hide-if-empty", ActionHideIfEmptyPropertyInfo), '("icon-name", ActionIconNamePropertyInfo), '("is-important", ActionIsImportantPropertyInfo), '("label", ActionLabelPropertyInfo), '("name", ActionNamePropertyInfo), '("sensitive", ActionSensitivePropertyInfo), '("short-label", ActionShortLabelPropertyInfo), '("stock-id", ActionStockIdPropertyInfo), '("tooltip", ActionTooltipPropertyInfo), '("visible", ActionVisiblePropertyInfo), '("visible-horizontal", ActionVisibleHorizontalPropertyInfo), '("visible-overflown", ActionVisibleOverflownPropertyInfo), '("visible-vertical", ActionVisibleVerticalPropertyInfo)] -- VVV Prop "active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToggleButtonActive :: (MonadIO m, ToggleButtonK o) => o -> m Bool getToggleButtonActive obj = liftIO $ getObjectPropertyBool obj "active" setToggleButtonActive :: (MonadIO m, ToggleButtonK o) => o -> Bool -> m () setToggleButtonActive obj val = liftIO $ setObjectPropertyBool obj "active" val constructToggleButtonActive :: Bool -> IO ([Char], GValue) constructToggleButtonActive val = constructObjectPropertyBool "active" val data ToggleButtonActivePropertyInfo instance AttrInfo ToggleButtonActivePropertyInfo where type AttrAllowedOps ToggleButtonActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToggleButtonActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint ToggleButtonActivePropertyInfo = ToggleButtonK type AttrGetType ToggleButtonActivePropertyInfo = Bool type AttrLabel ToggleButtonActivePropertyInfo = "ToggleButton::active" attrGet _ = getToggleButtonActive attrSet _ = setToggleButtonActive attrConstruct _ = constructToggleButtonActive -- VVV Prop "draw-indicator" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToggleButtonDrawIndicator :: (MonadIO m, ToggleButtonK o) => o -> m Bool getToggleButtonDrawIndicator obj = liftIO $ getObjectPropertyBool obj "draw-indicator" setToggleButtonDrawIndicator :: (MonadIO m, ToggleButtonK o) => o -> Bool -> m () setToggleButtonDrawIndicator obj val = liftIO $ setObjectPropertyBool obj "draw-indicator" val constructToggleButtonDrawIndicator :: Bool -> IO ([Char], GValue) constructToggleButtonDrawIndicator val = constructObjectPropertyBool "draw-indicator" val data ToggleButtonDrawIndicatorPropertyInfo instance AttrInfo ToggleButtonDrawIndicatorPropertyInfo where type AttrAllowedOps ToggleButtonDrawIndicatorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToggleButtonDrawIndicatorPropertyInfo = (~) Bool type AttrBaseTypeConstraint ToggleButtonDrawIndicatorPropertyInfo = ToggleButtonK type AttrGetType ToggleButtonDrawIndicatorPropertyInfo = Bool type AttrLabel ToggleButtonDrawIndicatorPropertyInfo = "ToggleButton::draw-indicator" attrGet _ = getToggleButtonDrawIndicator attrSet _ = setToggleButtonDrawIndicator attrConstruct _ = constructToggleButtonDrawIndicator -- VVV Prop "inconsistent" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToggleButtonInconsistent :: (MonadIO m, ToggleButtonK o) => o -> m Bool getToggleButtonInconsistent obj = liftIO $ getObjectPropertyBool obj "inconsistent" setToggleButtonInconsistent :: (MonadIO m, ToggleButtonK o) => o -> Bool -> m () setToggleButtonInconsistent obj val = liftIO $ setObjectPropertyBool obj "inconsistent" val constructToggleButtonInconsistent :: Bool -> IO ([Char], GValue) constructToggleButtonInconsistent val = constructObjectPropertyBool "inconsistent" val data ToggleButtonInconsistentPropertyInfo instance AttrInfo ToggleButtonInconsistentPropertyInfo where type AttrAllowedOps ToggleButtonInconsistentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToggleButtonInconsistentPropertyInfo = (~) Bool type AttrBaseTypeConstraint ToggleButtonInconsistentPropertyInfo = ToggleButtonK type AttrGetType ToggleButtonInconsistentPropertyInfo = Bool type AttrLabel ToggleButtonInconsistentPropertyInfo = "ToggleButton::inconsistent" attrGet _ = getToggleButtonInconsistent attrSet _ = setToggleButtonInconsistent attrConstruct _ = constructToggleButtonInconsistent type instance AttributeList ToggleButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("active", ToggleButtonActivePropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-indicator", ToggleButtonDrawIndicatorPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("inconsistent", ToggleButtonInconsistentPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] type instance AttributeList ToggleButtonAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToggleToolButtonActive :: (MonadIO m, ToggleToolButtonK o) => o -> m Bool getToggleToolButtonActive obj = liftIO $ getObjectPropertyBool obj "active" setToggleToolButtonActive :: (MonadIO m, ToggleToolButtonK o) => o -> Bool -> m () setToggleToolButtonActive obj val = liftIO $ setObjectPropertyBool obj "active" val constructToggleToolButtonActive :: Bool -> IO ([Char], GValue) constructToggleToolButtonActive val = constructObjectPropertyBool "active" val data ToggleToolButtonActivePropertyInfo instance AttrInfo ToggleToolButtonActivePropertyInfo where type AttrAllowedOps ToggleToolButtonActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToggleToolButtonActivePropertyInfo = (~) Bool type AttrBaseTypeConstraint ToggleToolButtonActivePropertyInfo = ToggleToolButtonK type AttrGetType ToggleToolButtonActivePropertyInfo = Bool type AttrLabel ToggleToolButtonActivePropertyInfo = "ToggleToolButton::active" attrGet _ = getToggleToolButtonActive attrSet _ = setToggleToolButtonActive attrConstruct _ = constructToggleToolButtonActive type instance AttributeList ToggleToolButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("active", ToggleToolButtonActivePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("icon-name", ToolButtonIconNamePropertyInfo), '("icon-widget", ToolButtonIconWidgetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-important", ToolItemIsImportantPropertyInfo), '("label", ToolButtonLabelPropertyInfo), '("label-widget", ToolButtonLabelWidgetPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("stock-id", ToolButtonStockIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-underline", ToolButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("visible-horizontal", ToolItemVisibleHorizontalPropertyInfo), '("visible-vertical", ToolItemVisibleVerticalPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "icon-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getToolButtonIconName :: (MonadIO m, ToolButtonK o) => o -> m T.Text getToolButtonIconName obj = liftIO $ getObjectPropertyString obj "icon-name" setToolButtonIconName :: (MonadIO m, ToolButtonK o) => o -> T.Text -> m () setToolButtonIconName obj val = liftIO $ setObjectPropertyString obj "icon-name" val constructToolButtonIconName :: T.Text -> IO ([Char], GValue) constructToolButtonIconName val = constructObjectPropertyString "icon-name" val data ToolButtonIconNamePropertyInfo instance AttrInfo ToolButtonIconNamePropertyInfo where type AttrAllowedOps ToolButtonIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolButtonIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ToolButtonIconNamePropertyInfo = ToolButtonK type AttrGetType ToolButtonIconNamePropertyInfo = T.Text type AttrLabel ToolButtonIconNamePropertyInfo = "ToolButton::icon-name" attrGet _ = getToolButtonIconName attrSet _ = setToolButtonIconName attrConstruct _ = constructToolButtonIconName -- VVV Prop "icon-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getToolButtonIconWidget :: (MonadIO m, ToolButtonK o) => o -> m Widget getToolButtonIconWidget obj = liftIO $ getObjectPropertyObject obj "icon-widget" Widget setToolButtonIconWidget :: (MonadIO m, ToolButtonK o, WidgetK a) => o -> a -> m () setToolButtonIconWidget obj val = liftIO $ setObjectPropertyObject obj "icon-widget" val constructToolButtonIconWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructToolButtonIconWidget val = constructObjectPropertyObject "icon-widget" val data ToolButtonIconWidgetPropertyInfo instance AttrInfo ToolButtonIconWidgetPropertyInfo where type AttrAllowedOps ToolButtonIconWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolButtonIconWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint ToolButtonIconWidgetPropertyInfo = ToolButtonK type AttrGetType ToolButtonIconWidgetPropertyInfo = Widget type AttrLabel ToolButtonIconWidgetPropertyInfo = "ToolButton::icon-widget" attrGet _ = getToolButtonIconWidget attrSet _ = setToolButtonIconWidget attrConstruct _ = constructToolButtonIconWidget -- VVV Prop "label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getToolButtonLabel :: (MonadIO m, ToolButtonK o) => o -> m T.Text getToolButtonLabel obj = liftIO $ getObjectPropertyString obj "label" setToolButtonLabel :: (MonadIO m, ToolButtonK o) => o -> T.Text -> m () setToolButtonLabel obj val = liftIO $ setObjectPropertyString obj "label" val constructToolButtonLabel :: T.Text -> IO ([Char], GValue) constructToolButtonLabel val = constructObjectPropertyString "label" val data ToolButtonLabelPropertyInfo instance AttrInfo ToolButtonLabelPropertyInfo where type AttrAllowedOps ToolButtonLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolButtonLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ToolButtonLabelPropertyInfo = ToolButtonK type AttrGetType ToolButtonLabelPropertyInfo = T.Text type AttrLabel ToolButtonLabelPropertyInfo = "ToolButton::label" attrGet _ = getToolButtonLabel attrSet _ = setToolButtonLabel attrConstruct _ = constructToolButtonLabel -- VVV Prop "label-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getToolButtonLabelWidget :: (MonadIO m, ToolButtonK o) => o -> m Widget getToolButtonLabelWidget obj = liftIO $ getObjectPropertyObject obj "label-widget" Widget setToolButtonLabelWidget :: (MonadIO m, ToolButtonK o, WidgetK a) => o -> a -> m () setToolButtonLabelWidget obj val = liftIO $ setObjectPropertyObject obj "label-widget" val constructToolButtonLabelWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructToolButtonLabelWidget val = constructObjectPropertyObject "label-widget" val data ToolButtonLabelWidgetPropertyInfo instance AttrInfo ToolButtonLabelWidgetPropertyInfo where type AttrAllowedOps ToolButtonLabelWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolButtonLabelWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint ToolButtonLabelWidgetPropertyInfo = ToolButtonK type AttrGetType ToolButtonLabelWidgetPropertyInfo = Widget type AttrLabel ToolButtonLabelWidgetPropertyInfo = "ToolButton::label-widget" attrGet _ = getToolButtonLabelWidget attrSet _ = setToolButtonLabelWidget attrConstruct _ = constructToolButtonLabelWidget -- VVV Prop "stock-id" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getToolButtonStockId :: (MonadIO m, ToolButtonK o) => o -> m T.Text getToolButtonStockId obj = liftIO $ getObjectPropertyString obj "stock-id" setToolButtonStockId :: (MonadIO m, ToolButtonK o) => o -> T.Text -> m () setToolButtonStockId obj val = liftIO $ setObjectPropertyString obj "stock-id" val constructToolButtonStockId :: T.Text -> IO ([Char], GValue) constructToolButtonStockId val = constructObjectPropertyString "stock-id" val data ToolButtonStockIdPropertyInfo instance AttrInfo ToolButtonStockIdPropertyInfo where type AttrAllowedOps ToolButtonStockIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolButtonStockIdPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ToolButtonStockIdPropertyInfo = ToolButtonK type AttrGetType ToolButtonStockIdPropertyInfo = T.Text type AttrLabel ToolButtonStockIdPropertyInfo = "ToolButton::stock-id" attrGet _ = getToolButtonStockId attrSet _ = setToolButtonStockId attrConstruct _ = constructToolButtonStockId -- VVV Prop "use-underline" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToolButtonUseUnderline :: (MonadIO m, ToolButtonK o) => o -> m Bool getToolButtonUseUnderline obj = liftIO $ getObjectPropertyBool obj "use-underline" setToolButtonUseUnderline :: (MonadIO m, ToolButtonK o) => o -> Bool -> m () setToolButtonUseUnderline obj val = liftIO $ setObjectPropertyBool obj "use-underline" val constructToolButtonUseUnderline :: Bool -> IO ([Char], GValue) constructToolButtonUseUnderline val = constructObjectPropertyBool "use-underline" val data ToolButtonUseUnderlinePropertyInfo instance AttrInfo ToolButtonUseUnderlinePropertyInfo where type AttrAllowedOps ToolButtonUseUnderlinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolButtonUseUnderlinePropertyInfo = (~) Bool type AttrBaseTypeConstraint ToolButtonUseUnderlinePropertyInfo = ToolButtonK type AttrGetType ToolButtonUseUnderlinePropertyInfo = Bool type AttrLabel ToolButtonUseUnderlinePropertyInfo = "ToolButton::use-underline" attrGet _ = getToolButtonUseUnderline attrSet _ = setToolButtonUseUnderline attrConstruct _ = constructToolButtonUseUnderline type instance AttributeList ToolButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("icon-name", ToolButtonIconNamePropertyInfo), '("icon-widget", ToolButtonIconWidgetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-important", ToolItemIsImportantPropertyInfo), '("label", ToolButtonLabelPropertyInfo), '("label-widget", ToolButtonLabelWidgetPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("stock-id", ToolButtonStockIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-underline", ToolButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("visible-horizontal", ToolItemVisibleHorizontalPropertyInfo), '("visible-vertical", ToolItemVisibleVerticalPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "is-important" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToolItemIsImportant :: (MonadIO m, ToolItemK o) => o -> m Bool getToolItemIsImportant obj = liftIO $ getObjectPropertyBool obj "is-important" setToolItemIsImportant :: (MonadIO m, ToolItemK o) => o -> Bool -> m () setToolItemIsImportant obj val = liftIO $ setObjectPropertyBool obj "is-important" val constructToolItemIsImportant :: Bool -> IO ([Char], GValue) constructToolItemIsImportant val = constructObjectPropertyBool "is-important" val data ToolItemIsImportantPropertyInfo instance AttrInfo ToolItemIsImportantPropertyInfo where type AttrAllowedOps ToolItemIsImportantPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolItemIsImportantPropertyInfo = (~) Bool type AttrBaseTypeConstraint ToolItemIsImportantPropertyInfo = ToolItemK type AttrGetType ToolItemIsImportantPropertyInfo = Bool type AttrLabel ToolItemIsImportantPropertyInfo = "ToolItem::is-important" attrGet _ = getToolItemIsImportant attrSet _ = setToolItemIsImportant attrConstruct _ = constructToolItemIsImportant -- VVV Prop "visible-horizontal" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToolItemVisibleHorizontal :: (MonadIO m, ToolItemK o) => o -> m Bool getToolItemVisibleHorizontal obj = liftIO $ getObjectPropertyBool obj "visible-horizontal" setToolItemVisibleHorizontal :: (MonadIO m, ToolItemK o) => o -> Bool -> m () setToolItemVisibleHorizontal obj val = liftIO $ setObjectPropertyBool obj "visible-horizontal" val constructToolItemVisibleHorizontal :: Bool -> IO ([Char], GValue) constructToolItemVisibleHorizontal val = constructObjectPropertyBool "visible-horizontal" val data ToolItemVisibleHorizontalPropertyInfo instance AttrInfo ToolItemVisibleHorizontalPropertyInfo where type AttrAllowedOps ToolItemVisibleHorizontalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolItemVisibleHorizontalPropertyInfo = (~) Bool type AttrBaseTypeConstraint ToolItemVisibleHorizontalPropertyInfo = ToolItemK type AttrGetType ToolItemVisibleHorizontalPropertyInfo = Bool type AttrLabel ToolItemVisibleHorizontalPropertyInfo = "ToolItem::visible-horizontal" attrGet _ = getToolItemVisibleHorizontal attrSet _ = setToolItemVisibleHorizontal attrConstruct _ = constructToolItemVisibleHorizontal -- VVV Prop "visible-vertical" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToolItemVisibleVertical :: (MonadIO m, ToolItemK o) => o -> m Bool getToolItemVisibleVertical obj = liftIO $ getObjectPropertyBool obj "visible-vertical" setToolItemVisibleVertical :: (MonadIO m, ToolItemK o) => o -> Bool -> m () setToolItemVisibleVertical obj val = liftIO $ setObjectPropertyBool obj "visible-vertical" val constructToolItemVisibleVertical :: Bool -> IO ([Char], GValue) constructToolItemVisibleVertical val = constructObjectPropertyBool "visible-vertical" val data ToolItemVisibleVerticalPropertyInfo instance AttrInfo ToolItemVisibleVerticalPropertyInfo where type AttrAllowedOps ToolItemVisibleVerticalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolItemVisibleVerticalPropertyInfo = (~) Bool type AttrBaseTypeConstraint ToolItemVisibleVerticalPropertyInfo = ToolItemK type AttrGetType ToolItemVisibleVerticalPropertyInfo = Bool type AttrLabel ToolItemVisibleVerticalPropertyInfo = "ToolItem::visible-vertical" attrGet _ = getToolItemVisibleVertical attrSet _ = setToolItemVisibleVertical attrConstruct _ = constructToolItemVisibleVertical type instance AttributeList ToolItem = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-important", ToolItemIsImportantPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("visible-horizontal", ToolItemVisibleHorizontalPropertyInfo), '("visible-vertical", ToolItemVisibleVerticalPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "collapsed" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToolItemGroupCollapsed :: (MonadIO m, ToolItemGroupK o) => o -> m Bool getToolItemGroupCollapsed obj = liftIO $ getObjectPropertyBool obj "collapsed" setToolItemGroupCollapsed :: (MonadIO m, ToolItemGroupK o) => o -> Bool -> m () setToolItemGroupCollapsed obj val = liftIO $ setObjectPropertyBool obj "collapsed" val constructToolItemGroupCollapsed :: Bool -> IO ([Char], GValue) constructToolItemGroupCollapsed val = constructObjectPropertyBool "collapsed" val data ToolItemGroupCollapsedPropertyInfo instance AttrInfo ToolItemGroupCollapsedPropertyInfo where type AttrAllowedOps ToolItemGroupCollapsedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolItemGroupCollapsedPropertyInfo = (~) Bool type AttrBaseTypeConstraint ToolItemGroupCollapsedPropertyInfo = ToolItemGroupK type AttrGetType ToolItemGroupCollapsedPropertyInfo = Bool type AttrLabel ToolItemGroupCollapsedPropertyInfo = "ToolItemGroup::collapsed" attrGet _ = getToolItemGroupCollapsed attrSet _ = setToolItemGroupCollapsed attrConstruct _ = constructToolItemGroupCollapsed -- VVV Prop "ellipsize" -- Type: TInterface "Pango" "EllipsizeMode" -- Flags: [PropertyReadable,PropertyWritable] getToolItemGroupEllipsize :: (MonadIO m, ToolItemGroupK o) => o -> m Pango.EllipsizeMode getToolItemGroupEllipsize obj = liftIO $ getObjectPropertyEnum obj "ellipsize" setToolItemGroupEllipsize :: (MonadIO m, ToolItemGroupK o) => o -> Pango.EllipsizeMode -> m () setToolItemGroupEllipsize obj val = liftIO $ setObjectPropertyEnum obj "ellipsize" val constructToolItemGroupEllipsize :: Pango.EllipsizeMode -> IO ([Char], GValue) constructToolItemGroupEllipsize val = constructObjectPropertyEnum "ellipsize" val data ToolItemGroupEllipsizePropertyInfo instance AttrInfo ToolItemGroupEllipsizePropertyInfo where type AttrAllowedOps ToolItemGroupEllipsizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolItemGroupEllipsizePropertyInfo = (~) Pango.EllipsizeMode type AttrBaseTypeConstraint ToolItemGroupEllipsizePropertyInfo = ToolItemGroupK type AttrGetType ToolItemGroupEllipsizePropertyInfo = Pango.EllipsizeMode type AttrLabel ToolItemGroupEllipsizePropertyInfo = "ToolItemGroup::ellipsize" attrGet _ = getToolItemGroupEllipsize attrSet _ = setToolItemGroupEllipsize attrConstruct _ = constructToolItemGroupEllipsize -- VVV Prop "header-relief" -- Type: TInterface "Gtk" "ReliefStyle" -- Flags: [PropertyReadable,PropertyWritable] getToolItemGroupHeaderRelief :: (MonadIO m, ToolItemGroupK o) => o -> m ReliefStyle getToolItemGroupHeaderRelief obj = liftIO $ getObjectPropertyEnum obj "header-relief" setToolItemGroupHeaderRelief :: (MonadIO m, ToolItemGroupK o) => o -> ReliefStyle -> m () setToolItemGroupHeaderRelief obj val = liftIO $ setObjectPropertyEnum obj "header-relief" val constructToolItemGroupHeaderRelief :: ReliefStyle -> IO ([Char], GValue) constructToolItemGroupHeaderRelief val = constructObjectPropertyEnum "header-relief" val data ToolItemGroupHeaderReliefPropertyInfo instance AttrInfo ToolItemGroupHeaderReliefPropertyInfo where type AttrAllowedOps ToolItemGroupHeaderReliefPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolItemGroupHeaderReliefPropertyInfo = (~) ReliefStyle type AttrBaseTypeConstraint ToolItemGroupHeaderReliefPropertyInfo = ToolItemGroupK type AttrGetType ToolItemGroupHeaderReliefPropertyInfo = ReliefStyle type AttrLabel ToolItemGroupHeaderReliefPropertyInfo = "ToolItemGroup::header-relief" attrGet _ = getToolItemGroupHeaderRelief attrSet _ = setToolItemGroupHeaderRelief attrConstruct _ = constructToolItemGroupHeaderRelief -- VVV Prop "label" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getToolItemGroupLabel :: (MonadIO m, ToolItemGroupK o) => o -> m T.Text getToolItemGroupLabel obj = liftIO $ getObjectPropertyString obj "label" setToolItemGroupLabel :: (MonadIO m, ToolItemGroupK o) => o -> T.Text -> m () setToolItemGroupLabel obj val = liftIO $ setObjectPropertyString obj "label" val constructToolItemGroupLabel :: T.Text -> IO ([Char], GValue) constructToolItemGroupLabel val = constructObjectPropertyString "label" val data ToolItemGroupLabelPropertyInfo instance AttrInfo ToolItemGroupLabelPropertyInfo where type AttrAllowedOps ToolItemGroupLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolItemGroupLabelPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ToolItemGroupLabelPropertyInfo = ToolItemGroupK type AttrGetType ToolItemGroupLabelPropertyInfo = T.Text type AttrLabel ToolItemGroupLabelPropertyInfo = "ToolItemGroup::label" attrGet _ = getToolItemGroupLabel attrSet _ = setToolItemGroupLabel attrConstruct _ = constructToolItemGroupLabel -- VVV Prop "label-widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getToolItemGroupLabelWidget :: (MonadIO m, ToolItemGroupK o) => o -> m Widget getToolItemGroupLabelWidget obj = liftIO $ getObjectPropertyObject obj "label-widget" Widget setToolItemGroupLabelWidget :: (MonadIO m, ToolItemGroupK o, WidgetK a) => o -> a -> m () setToolItemGroupLabelWidget obj val = liftIO $ setObjectPropertyObject obj "label-widget" val constructToolItemGroupLabelWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructToolItemGroupLabelWidget val = constructObjectPropertyObject "label-widget" val data ToolItemGroupLabelWidgetPropertyInfo instance AttrInfo ToolItemGroupLabelWidgetPropertyInfo where type AttrAllowedOps ToolItemGroupLabelWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolItemGroupLabelWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint ToolItemGroupLabelWidgetPropertyInfo = ToolItemGroupK type AttrGetType ToolItemGroupLabelWidgetPropertyInfo = Widget type AttrLabel ToolItemGroupLabelWidgetPropertyInfo = "ToolItemGroup::label-widget" attrGet _ = getToolItemGroupLabelWidget attrSet _ = setToolItemGroupLabelWidget attrConstruct _ = constructToolItemGroupLabelWidget type instance AttributeList ToolItemGroup = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("collapsed", ToolItemGroupCollapsedPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("ellipsize", ToolItemGroupEllipsizePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("header-relief", ToolItemGroupHeaderReliefPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ToolItemGroupLabelPropertyInfo), '("label-widget", ToolItemGroupLabelWidgetPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "icon-size" -- Type: TInterface "Gtk" "IconSize" -- Flags: [PropertyReadable,PropertyWritable] getToolPaletteIconSize :: (MonadIO m, ToolPaletteK o) => o -> m IconSize getToolPaletteIconSize obj = liftIO $ getObjectPropertyEnum obj "icon-size" setToolPaletteIconSize :: (MonadIO m, ToolPaletteK o) => o -> IconSize -> m () setToolPaletteIconSize obj val = liftIO $ setObjectPropertyEnum obj "icon-size" val constructToolPaletteIconSize :: IconSize -> IO ([Char], GValue) constructToolPaletteIconSize val = constructObjectPropertyEnum "icon-size" val data ToolPaletteIconSizePropertyInfo instance AttrInfo ToolPaletteIconSizePropertyInfo where type AttrAllowedOps ToolPaletteIconSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolPaletteIconSizePropertyInfo = (~) IconSize type AttrBaseTypeConstraint ToolPaletteIconSizePropertyInfo = ToolPaletteK type AttrGetType ToolPaletteIconSizePropertyInfo = IconSize type AttrLabel ToolPaletteIconSizePropertyInfo = "ToolPalette::icon-size" attrGet _ = getToolPaletteIconSize attrSet _ = setToolPaletteIconSize attrConstruct _ = constructToolPaletteIconSize -- VVV Prop "icon-size-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToolPaletteIconSizeSet :: (MonadIO m, ToolPaletteK o) => o -> m Bool getToolPaletteIconSizeSet obj = liftIO $ getObjectPropertyBool obj "icon-size-set" setToolPaletteIconSizeSet :: (MonadIO m, ToolPaletteK o) => o -> Bool -> m () setToolPaletteIconSizeSet obj val = liftIO $ setObjectPropertyBool obj "icon-size-set" val constructToolPaletteIconSizeSet :: Bool -> IO ([Char], GValue) constructToolPaletteIconSizeSet val = constructObjectPropertyBool "icon-size-set" val data ToolPaletteIconSizeSetPropertyInfo instance AttrInfo ToolPaletteIconSizeSetPropertyInfo where type AttrAllowedOps ToolPaletteIconSizeSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolPaletteIconSizeSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint ToolPaletteIconSizeSetPropertyInfo = ToolPaletteK type AttrGetType ToolPaletteIconSizeSetPropertyInfo = Bool type AttrLabel ToolPaletteIconSizeSetPropertyInfo = "ToolPalette::icon-size-set" attrGet _ = getToolPaletteIconSizeSet attrSet _ = setToolPaletteIconSizeSet attrConstruct _ = constructToolPaletteIconSizeSet -- VVV Prop "toolbar-style" -- Type: TInterface "Gtk" "ToolbarStyle" -- Flags: [PropertyReadable,PropertyWritable] getToolPaletteToolbarStyle :: (MonadIO m, ToolPaletteK o) => o -> m ToolbarStyle getToolPaletteToolbarStyle obj = liftIO $ getObjectPropertyEnum obj "toolbar-style" setToolPaletteToolbarStyle :: (MonadIO m, ToolPaletteK o) => o -> ToolbarStyle -> m () setToolPaletteToolbarStyle obj val = liftIO $ setObjectPropertyEnum obj "toolbar-style" val constructToolPaletteToolbarStyle :: ToolbarStyle -> IO ([Char], GValue) constructToolPaletteToolbarStyle val = constructObjectPropertyEnum "toolbar-style" val data ToolPaletteToolbarStylePropertyInfo instance AttrInfo ToolPaletteToolbarStylePropertyInfo where type AttrAllowedOps ToolPaletteToolbarStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolPaletteToolbarStylePropertyInfo = (~) ToolbarStyle type AttrBaseTypeConstraint ToolPaletteToolbarStylePropertyInfo = ToolPaletteK type AttrGetType ToolPaletteToolbarStylePropertyInfo = ToolbarStyle type AttrLabel ToolPaletteToolbarStylePropertyInfo = "ToolPalette::toolbar-style" attrGet _ = getToolPaletteToolbarStyle attrSet _ = setToolPaletteToolbarStyle attrConstruct _ = constructToolPaletteToolbarStyle type instance AttributeList ToolPalette = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("hadjustment", ScrollableHadjustmentPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hscroll-policy", ScrollableHscrollPolicyPropertyInfo), '("icon-size", ToolPaletteIconSizePropertyInfo), '("icon-size-set", ToolPaletteIconSizeSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("toolbar-style", ToolPaletteToolbarStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("vadjustment", ScrollableVadjustmentPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("vscroll-policy", ScrollableVscrollPolicyPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList ToolShell = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "icon-size" -- Type: TInterface "Gtk" "IconSize" -- Flags: [PropertyReadable,PropertyWritable] getToolbarIconSize :: (MonadIO m, ToolbarK o) => o -> m IconSize getToolbarIconSize obj = liftIO $ getObjectPropertyEnum obj "icon-size" setToolbarIconSize :: (MonadIO m, ToolbarK o) => o -> IconSize -> m () setToolbarIconSize obj val = liftIO $ setObjectPropertyEnum obj "icon-size" val constructToolbarIconSize :: IconSize -> IO ([Char], GValue) constructToolbarIconSize val = constructObjectPropertyEnum "icon-size" val data ToolbarIconSizePropertyInfo instance AttrInfo ToolbarIconSizePropertyInfo where type AttrAllowedOps ToolbarIconSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolbarIconSizePropertyInfo = (~) IconSize type AttrBaseTypeConstraint ToolbarIconSizePropertyInfo = ToolbarK type AttrGetType ToolbarIconSizePropertyInfo = IconSize type AttrLabel ToolbarIconSizePropertyInfo = "Toolbar::icon-size" attrGet _ = getToolbarIconSize attrSet _ = setToolbarIconSize attrConstruct _ = constructToolbarIconSize -- VVV Prop "icon-size-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToolbarIconSizeSet :: (MonadIO m, ToolbarK o) => o -> m Bool getToolbarIconSizeSet obj = liftIO $ getObjectPropertyBool obj "icon-size-set" setToolbarIconSizeSet :: (MonadIO m, ToolbarK o) => o -> Bool -> m () setToolbarIconSizeSet obj val = liftIO $ setObjectPropertyBool obj "icon-size-set" val constructToolbarIconSizeSet :: Bool -> IO ([Char], GValue) constructToolbarIconSizeSet val = constructObjectPropertyBool "icon-size-set" val data ToolbarIconSizeSetPropertyInfo instance AttrInfo ToolbarIconSizeSetPropertyInfo where type AttrAllowedOps ToolbarIconSizeSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolbarIconSizeSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint ToolbarIconSizeSetPropertyInfo = ToolbarK type AttrGetType ToolbarIconSizeSetPropertyInfo = Bool type AttrLabel ToolbarIconSizeSetPropertyInfo = "Toolbar::icon-size-set" attrGet _ = getToolbarIconSizeSet attrSet _ = setToolbarIconSizeSet attrConstruct _ = constructToolbarIconSizeSet -- VVV Prop "show-arrow" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getToolbarShowArrow :: (MonadIO m, ToolbarK o) => o -> m Bool getToolbarShowArrow obj = liftIO $ getObjectPropertyBool obj "show-arrow" setToolbarShowArrow :: (MonadIO m, ToolbarK o) => o -> Bool -> m () setToolbarShowArrow obj val = liftIO $ setObjectPropertyBool obj "show-arrow" val constructToolbarShowArrow :: Bool -> IO ([Char], GValue) constructToolbarShowArrow val = constructObjectPropertyBool "show-arrow" val data ToolbarShowArrowPropertyInfo instance AttrInfo ToolbarShowArrowPropertyInfo where type AttrAllowedOps ToolbarShowArrowPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolbarShowArrowPropertyInfo = (~) Bool type AttrBaseTypeConstraint ToolbarShowArrowPropertyInfo = ToolbarK type AttrGetType ToolbarShowArrowPropertyInfo = Bool type AttrLabel ToolbarShowArrowPropertyInfo = "Toolbar::show-arrow" attrGet _ = getToolbarShowArrow attrSet _ = setToolbarShowArrow attrConstruct _ = constructToolbarShowArrow -- VVV Prop "toolbar-style" -- Type: TInterface "Gtk" "ToolbarStyle" -- Flags: [PropertyReadable,PropertyWritable] getToolbarToolbarStyle :: (MonadIO m, ToolbarK o) => o -> m ToolbarStyle getToolbarToolbarStyle obj = liftIO $ getObjectPropertyEnum obj "toolbar-style" setToolbarToolbarStyle :: (MonadIO m, ToolbarK o) => o -> ToolbarStyle -> m () setToolbarToolbarStyle obj val = liftIO $ setObjectPropertyEnum obj "toolbar-style" val constructToolbarToolbarStyle :: ToolbarStyle -> IO ([Char], GValue) constructToolbarToolbarStyle val = constructObjectPropertyEnum "toolbar-style" val data ToolbarToolbarStylePropertyInfo instance AttrInfo ToolbarToolbarStylePropertyInfo where type AttrAllowedOps ToolbarToolbarStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ToolbarToolbarStylePropertyInfo = (~) ToolbarStyle type AttrBaseTypeConstraint ToolbarToolbarStylePropertyInfo = ToolbarK type AttrGetType ToolbarToolbarStylePropertyInfo = ToolbarStyle type AttrLabel ToolbarToolbarStylePropertyInfo = "Toolbar::toolbar-style" attrGet _ = getToolbarToolbarStyle attrSet _ = setToolbarToolbarStyle attrConstruct _ = constructToolbarToolbarStyle type instance AttributeList Toolbar = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("icon-size", ToolbarIconSizePropertyInfo), '("icon-size-set", ToolbarIconSizeSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-arrow", ToolbarShowArrowPropertyInfo), '("style", WidgetStylePropertyInfo), '("toolbar-style", ToolbarToolbarStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList Tooltip = '[ ] type instance AttributeList ToplevelAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo)] type instance AttributeList TreeDragDest = '[ ] type instance AttributeList TreeDragSource = '[ ] type instance AttributeList TreeModel = '[ ] -- VVV Prop "child-model" -- Type: TInterface "Gtk" "TreeModel" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTreeModelFilterChildModel :: (MonadIO m, TreeModelFilterK o) => o -> m TreeModel getTreeModelFilterChildModel obj = liftIO $ getObjectPropertyObject obj "child-model" TreeModel constructTreeModelFilterChildModel :: (TreeModelK a) => a -> IO ([Char], GValue) constructTreeModelFilterChildModel val = constructObjectPropertyObject "child-model" val data TreeModelFilterChildModelPropertyInfo instance AttrInfo TreeModelFilterChildModelPropertyInfo where type AttrAllowedOps TreeModelFilterChildModelPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeModelFilterChildModelPropertyInfo = TreeModelK type AttrBaseTypeConstraint TreeModelFilterChildModelPropertyInfo = TreeModelFilterK type AttrGetType TreeModelFilterChildModelPropertyInfo = TreeModel type AttrLabel TreeModelFilterChildModelPropertyInfo = "TreeModelFilter::child-model" attrGet _ = getTreeModelFilterChildModel attrSet _ = undefined attrConstruct _ = constructTreeModelFilterChildModel -- VVV Prop "virtual-root" -- Type: TInterface "Gtk" "TreePath" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTreeModelFilterVirtualRoot :: (MonadIO m, TreeModelFilterK o) => o -> m TreePath getTreeModelFilterVirtualRoot obj = liftIO $ getObjectPropertyBoxed obj "virtual-root" TreePath constructTreeModelFilterVirtualRoot :: TreePath -> IO ([Char], GValue) constructTreeModelFilterVirtualRoot val = constructObjectPropertyBoxed "virtual-root" val data TreeModelFilterVirtualRootPropertyInfo instance AttrInfo TreeModelFilterVirtualRootPropertyInfo where type AttrAllowedOps TreeModelFilterVirtualRootPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeModelFilterVirtualRootPropertyInfo = (~) TreePath type AttrBaseTypeConstraint TreeModelFilterVirtualRootPropertyInfo = TreeModelFilterK type AttrGetType TreeModelFilterVirtualRootPropertyInfo = TreePath type AttrLabel TreeModelFilterVirtualRootPropertyInfo = "TreeModelFilter::virtual-root" attrGet _ = getTreeModelFilterVirtualRoot attrSet _ = undefined attrConstruct _ = constructTreeModelFilterVirtualRoot type instance AttributeList TreeModelFilter = '[ '("child-model", TreeModelFilterChildModelPropertyInfo), '("virtual-root", TreeModelFilterVirtualRootPropertyInfo)] -- VVV Prop "model" -- Type: TInterface "Gtk" "TreeModel" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTreeModelSortModel :: (MonadIO m, TreeModelSortK o) => o -> m TreeModel getTreeModelSortModel obj = liftIO $ getObjectPropertyObject obj "model" TreeModel constructTreeModelSortModel :: (TreeModelK a) => a -> IO ([Char], GValue) constructTreeModelSortModel val = constructObjectPropertyObject "model" val data TreeModelSortModelPropertyInfo instance AttrInfo TreeModelSortModelPropertyInfo where type AttrAllowedOps TreeModelSortModelPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeModelSortModelPropertyInfo = TreeModelK type AttrBaseTypeConstraint TreeModelSortModelPropertyInfo = TreeModelSortK type AttrGetType TreeModelSortModelPropertyInfo = TreeModel type AttrLabel TreeModelSortModelPropertyInfo = "TreeModelSort::model" attrGet _ = getTreeModelSortModel attrSet _ = undefined attrConstruct _ = constructTreeModelSortModel type instance AttributeList TreeModelSort = '[ '("model", TreeModelSortModelPropertyInfo)] -- VVV Prop "mode" -- Type: TInterface "Gtk" "SelectionMode" -- Flags: [PropertyReadable,PropertyWritable] getTreeSelectionMode :: (MonadIO m, TreeSelectionK o) => o -> m SelectionMode getTreeSelectionMode obj = liftIO $ getObjectPropertyEnum obj "mode" setTreeSelectionMode :: (MonadIO m, TreeSelectionK o) => o -> SelectionMode -> m () setTreeSelectionMode obj val = liftIO $ setObjectPropertyEnum obj "mode" val constructTreeSelectionMode :: SelectionMode -> IO ([Char], GValue) constructTreeSelectionMode val = constructObjectPropertyEnum "mode" val data TreeSelectionModePropertyInfo instance AttrInfo TreeSelectionModePropertyInfo where type AttrAllowedOps TreeSelectionModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeSelectionModePropertyInfo = (~) SelectionMode type AttrBaseTypeConstraint TreeSelectionModePropertyInfo = TreeSelectionK type AttrGetType TreeSelectionModePropertyInfo = SelectionMode type AttrLabel TreeSelectionModePropertyInfo = "TreeSelection::mode" attrGet _ = getTreeSelectionMode attrSet _ = setTreeSelectionMode attrConstruct _ = constructTreeSelectionMode type instance AttributeList TreeSelection = '[ '("mode", TreeSelectionModePropertyInfo)] type instance AttributeList TreeSortable = '[ ] type instance AttributeList TreeStore = '[ ] -- VVV Prop "activate-on-single-click" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewActivateOnSingleClick :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewActivateOnSingleClick obj = liftIO $ getObjectPropertyBool obj "activate-on-single-click" setTreeViewActivateOnSingleClick :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewActivateOnSingleClick obj val = liftIO $ setObjectPropertyBool obj "activate-on-single-click" val constructTreeViewActivateOnSingleClick :: Bool -> IO ([Char], GValue) constructTreeViewActivateOnSingleClick val = constructObjectPropertyBool "activate-on-single-click" val data TreeViewActivateOnSingleClickPropertyInfo instance AttrInfo TreeViewActivateOnSingleClickPropertyInfo where type AttrAllowedOps TreeViewActivateOnSingleClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewActivateOnSingleClickPropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewActivateOnSingleClickPropertyInfo = TreeViewK type AttrGetType TreeViewActivateOnSingleClickPropertyInfo = Bool type AttrLabel TreeViewActivateOnSingleClickPropertyInfo = "TreeView::activate-on-single-click" attrGet _ = getTreeViewActivateOnSingleClick attrSet _ = setTreeViewActivateOnSingleClick attrConstruct _ = constructTreeViewActivateOnSingleClick -- VVV Prop "enable-grid-lines" -- Type: TInterface "Gtk" "TreeViewGridLines" -- Flags: [PropertyReadable,PropertyWritable] getTreeViewEnableGridLines :: (MonadIO m, TreeViewK o) => o -> m TreeViewGridLines getTreeViewEnableGridLines obj = liftIO $ getObjectPropertyEnum obj "enable-grid-lines" setTreeViewEnableGridLines :: (MonadIO m, TreeViewK o) => o -> TreeViewGridLines -> m () setTreeViewEnableGridLines obj val = liftIO $ setObjectPropertyEnum obj "enable-grid-lines" val constructTreeViewEnableGridLines :: TreeViewGridLines -> IO ([Char], GValue) constructTreeViewEnableGridLines val = constructObjectPropertyEnum "enable-grid-lines" val data TreeViewEnableGridLinesPropertyInfo instance AttrInfo TreeViewEnableGridLinesPropertyInfo where type AttrAllowedOps TreeViewEnableGridLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewEnableGridLinesPropertyInfo = (~) TreeViewGridLines type AttrBaseTypeConstraint TreeViewEnableGridLinesPropertyInfo = TreeViewK type AttrGetType TreeViewEnableGridLinesPropertyInfo = TreeViewGridLines type AttrLabel TreeViewEnableGridLinesPropertyInfo = "TreeView::enable-grid-lines" attrGet _ = getTreeViewEnableGridLines attrSet _ = setTreeViewEnableGridLines attrConstruct _ = constructTreeViewEnableGridLines -- VVV Prop "enable-search" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewEnableSearch :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewEnableSearch obj = liftIO $ getObjectPropertyBool obj "enable-search" setTreeViewEnableSearch :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewEnableSearch obj val = liftIO $ setObjectPropertyBool obj "enable-search" val constructTreeViewEnableSearch :: Bool -> IO ([Char], GValue) constructTreeViewEnableSearch val = constructObjectPropertyBool "enable-search" val data TreeViewEnableSearchPropertyInfo instance AttrInfo TreeViewEnableSearchPropertyInfo where type AttrAllowedOps TreeViewEnableSearchPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewEnableSearchPropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewEnableSearchPropertyInfo = TreeViewK type AttrGetType TreeViewEnableSearchPropertyInfo = Bool type AttrLabel TreeViewEnableSearchPropertyInfo = "TreeView::enable-search" attrGet _ = getTreeViewEnableSearch attrSet _ = setTreeViewEnableSearch attrConstruct _ = constructTreeViewEnableSearch -- VVV Prop "enable-tree-lines" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewEnableTreeLines :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewEnableTreeLines obj = liftIO $ getObjectPropertyBool obj "enable-tree-lines" setTreeViewEnableTreeLines :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewEnableTreeLines obj val = liftIO $ setObjectPropertyBool obj "enable-tree-lines" val constructTreeViewEnableTreeLines :: Bool -> IO ([Char], GValue) constructTreeViewEnableTreeLines val = constructObjectPropertyBool "enable-tree-lines" val data TreeViewEnableTreeLinesPropertyInfo instance AttrInfo TreeViewEnableTreeLinesPropertyInfo where type AttrAllowedOps TreeViewEnableTreeLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewEnableTreeLinesPropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewEnableTreeLinesPropertyInfo = TreeViewK type AttrGetType TreeViewEnableTreeLinesPropertyInfo = Bool type AttrLabel TreeViewEnableTreeLinesPropertyInfo = "TreeView::enable-tree-lines" attrGet _ = getTreeViewEnableTreeLines attrSet _ = setTreeViewEnableTreeLines attrConstruct _ = constructTreeViewEnableTreeLines -- VVV Prop "expander-column" -- Type: TInterface "Gtk" "TreeViewColumn" -- Flags: [PropertyReadable,PropertyWritable] getTreeViewExpanderColumn :: (MonadIO m, TreeViewK o) => o -> m TreeViewColumn getTreeViewExpanderColumn obj = liftIO $ getObjectPropertyObject obj "expander-column" TreeViewColumn setTreeViewExpanderColumn :: (MonadIO m, TreeViewK o, TreeViewColumnK a) => o -> a -> m () setTreeViewExpanderColumn obj val = liftIO $ setObjectPropertyObject obj "expander-column" val constructTreeViewExpanderColumn :: (TreeViewColumnK a) => a -> IO ([Char], GValue) constructTreeViewExpanderColumn val = constructObjectPropertyObject "expander-column" val data TreeViewExpanderColumnPropertyInfo instance AttrInfo TreeViewExpanderColumnPropertyInfo where type AttrAllowedOps TreeViewExpanderColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewExpanderColumnPropertyInfo = TreeViewColumnK type AttrBaseTypeConstraint TreeViewExpanderColumnPropertyInfo = TreeViewK type AttrGetType TreeViewExpanderColumnPropertyInfo = TreeViewColumn type AttrLabel TreeViewExpanderColumnPropertyInfo = "TreeView::expander-column" attrGet _ = getTreeViewExpanderColumn attrSet _ = setTreeViewExpanderColumn attrConstruct _ = constructTreeViewExpanderColumn -- VVV Prop "fixed-height-mode" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewFixedHeightMode :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewFixedHeightMode obj = liftIO $ getObjectPropertyBool obj "fixed-height-mode" setTreeViewFixedHeightMode :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewFixedHeightMode obj val = liftIO $ setObjectPropertyBool obj "fixed-height-mode" val constructTreeViewFixedHeightMode :: Bool -> IO ([Char], GValue) constructTreeViewFixedHeightMode val = constructObjectPropertyBool "fixed-height-mode" val data TreeViewFixedHeightModePropertyInfo instance AttrInfo TreeViewFixedHeightModePropertyInfo where type AttrAllowedOps TreeViewFixedHeightModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewFixedHeightModePropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewFixedHeightModePropertyInfo = TreeViewK type AttrGetType TreeViewFixedHeightModePropertyInfo = Bool type AttrLabel TreeViewFixedHeightModePropertyInfo = "TreeView::fixed-height-mode" attrGet _ = getTreeViewFixedHeightMode attrSet _ = setTreeViewFixedHeightMode attrConstruct _ = constructTreeViewFixedHeightMode -- VVV Prop "headers-clickable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewHeadersClickable :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewHeadersClickable obj = liftIO $ getObjectPropertyBool obj "headers-clickable" setTreeViewHeadersClickable :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewHeadersClickable obj val = liftIO $ setObjectPropertyBool obj "headers-clickable" val constructTreeViewHeadersClickable :: Bool -> IO ([Char], GValue) constructTreeViewHeadersClickable val = constructObjectPropertyBool "headers-clickable" val data TreeViewHeadersClickablePropertyInfo instance AttrInfo TreeViewHeadersClickablePropertyInfo where type AttrAllowedOps TreeViewHeadersClickablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewHeadersClickablePropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewHeadersClickablePropertyInfo = TreeViewK type AttrGetType TreeViewHeadersClickablePropertyInfo = Bool type AttrLabel TreeViewHeadersClickablePropertyInfo = "TreeView::headers-clickable" attrGet _ = getTreeViewHeadersClickable attrSet _ = setTreeViewHeadersClickable attrConstruct _ = constructTreeViewHeadersClickable -- VVV Prop "headers-visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewHeadersVisible :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewHeadersVisible obj = liftIO $ getObjectPropertyBool obj "headers-visible" setTreeViewHeadersVisible :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewHeadersVisible obj val = liftIO $ setObjectPropertyBool obj "headers-visible" val constructTreeViewHeadersVisible :: Bool -> IO ([Char], GValue) constructTreeViewHeadersVisible val = constructObjectPropertyBool "headers-visible" val data TreeViewHeadersVisiblePropertyInfo instance AttrInfo TreeViewHeadersVisiblePropertyInfo where type AttrAllowedOps TreeViewHeadersVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewHeadersVisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewHeadersVisiblePropertyInfo = TreeViewK type AttrGetType TreeViewHeadersVisiblePropertyInfo = Bool type AttrLabel TreeViewHeadersVisiblePropertyInfo = "TreeView::headers-visible" attrGet _ = getTreeViewHeadersVisible attrSet _ = setTreeViewHeadersVisible attrConstruct _ = constructTreeViewHeadersVisible -- VVV Prop "hover-expand" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewHoverExpand :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewHoverExpand obj = liftIO $ getObjectPropertyBool obj "hover-expand" setTreeViewHoverExpand :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewHoverExpand obj val = liftIO $ setObjectPropertyBool obj "hover-expand" val constructTreeViewHoverExpand :: Bool -> IO ([Char], GValue) constructTreeViewHoverExpand val = constructObjectPropertyBool "hover-expand" val data TreeViewHoverExpandPropertyInfo instance AttrInfo TreeViewHoverExpandPropertyInfo where type AttrAllowedOps TreeViewHoverExpandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewHoverExpandPropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewHoverExpandPropertyInfo = TreeViewK type AttrGetType TreeViewHoverExpandPropertyInfo = Bool type AttrLabel TreeViewHoverExpandPropertyInfo = "TreeView::hover-expand" attrGet _ = getTreeViewHoverExpand attrSet _ = setTreeViewHoverExpand attrConstruct _ = constructTreeViewHoverExpand -- VVV Prop "hover-selection" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewHoverSelection :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewHoverSelection obj = liftIO $ getObjectPropertyBool obj "hover-selection" setTreeViewHoverSelection :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewHoverSelection obj val = liftIO $ setObjectPropertyBool obj "hover-selection" val constructTreeViewHoverSelection :: Bool -> IO ([Char], GValue) constructTreeViewHoverSelection val = constructObjectPropertyBool "hover-selection" val data TreeViewHoverSelectionPropertyInfo instance AttrInfo TreeViewHoverSelectionPropertyInfo where type AttrAllowedOps TreeViewHoverSelectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewHoverSelectionPropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewHoverSelectionPropertyInfo = TreeViewK type AttrGetType TreeViewHoverSelectionPropertyInfo = Bool type AttrLabel TreeViewHoverSelectionPropertyInfo = "TreeView::hover-selection" attrGet _ = getTreeViewHoverSelection attrSet _ = setTreeViewHoverSelection attrConstruct _ = constructTreeViewHoverSelection -- VVV Prop "level-indentation" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTreeViewLevelIndentation :: (MonadIO m, TreeViewK o) => o -> m Int32 getTreeViewLevelIndentation obj = liftIO $ getObjectPropertyCInt obj "level-indentation" setTreeViewLevelIndentation :: (MonadIO m, TreeViewK o) => o -> Int32 -> m () setTreeViewLevelIndentation obj val = liftIO $ setObjectPropertyCInt obj "level-indentation" val constructTreeViewLevelIndentation :: Int32 -> IO ([Char], GValue) constructTreeViewLevelIndentation val = constructObjectPropertyCInt "level-indentation" val data TreeViewLevelIndentationPropertyInfo instance AttrInfo TreeViewLevelIndentationPropertyInfo where type AttrAllowedOps TreeViewLevelIndentationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewLevelIndentationPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TreeViewLevelIndentationPropertyInfo = TreeViewK type AttrGetType TreeViewLevelIndentationPropertyInfo = Int32 type AttrLabel TreeViewLevelIndentationPropertyInfo = "TreeView::level-indentation" attrGet _ = getTreeViewLevelIndentation attrSet _ = setTreeViewLevelIndentation attrConstruct _ = constructTreeViewLevelIndentation -- VVV Prop "model" -- Type: TInterface "Gtk" "TreeModel" -- Flags: [PropertyReadable,PropertyWritable] getTreeViewModel :: (MonadIO m, TreeViewK o) => o -> m TreeModel getTreeViewModel obj = liftIO $ getObjectPropertyObject obj "model" TreeModel setTreeViewModel :: (MonadIO m, TreeViewK o, TreeModelK a) => o -> a -> m () setTreeViewModel obj val = liftIO $ setObjectPropertyObject obj "model" val constructTreeViewModel :: (TreeModelK a) => a -> IO ([Char], GValue) constructTreeViewModel val = constructObjectPropertyObject "model" val data TreeViewModelPropertyInfo instance AttrInfo TreeViewModelPropertyInfo where type AttrAllowedOps TreeViewModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewModelPropertyInfo = TreeModelK type AttrBaseTypeConstraint TreeViewModelPropertyInfo = TreeViewK type AttrGetType TreeViewModelPropertyInfo = TreeModel type AttrLabel TreeViewModelPropertyInfo = "TreeView::model" attrGet _ = getTreeViewModel attrSet _ = setTreeViewModel attrConstruct _ = constructTreeViewModel -- VVV Prop "reorderable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewReorderable :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewReorderable obj = liftIO $ getObjectPropertyBool obj "reorderable" setTreeViewReorderable :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewReorderable obj val = liftIO $ setObjectPropertyBool obj "reorderable" val constructTreeViewReorderable :: Bool -> IO ([Char], GValue) constructTreeViewReorderable val = constructObjectPropertyBool "reorderable" val data TreeViewReorderablePropertyInfo instance AttrInfo TreeViewReorderablePropertyInfo where type AttrAllowedOps TreeViewReorderablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewReorderablePropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewReorderablePropertyInfo = TreeViewK type AttrGetType TreeViewReorderablePropertyInfo = Bool type AttrLabel TreeViewReorderablePropertyInfo = "TreeView::reorderable" attrGet _ = getTreeViewReorderable attrSet _ = setTreeViewReorderable attrConstruct _ = constructTreeViewReorderable -- VVV Prop "rubber-banding" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewRubberBanding :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewRubberBanding obj = liftIO $ getObjectPropertyBool obj "rubber-banding" setTreeViewRubberBanding :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewRubberBanding obj val = liftIO $ setObjectPropertyBool obj "rubber-banding" val constructTreeViewRubberBanding :: Bool -> IO ([Char], GValue) constructTreeViewRubberBanding val = constructObjectPropertyBool "rubber-banding" val data TreeViewRubberBandingPropertyInfo instance AttrInfo TreeViewRubberBandingPropertyInfo where type AttrAllowedOps TreeViewRubberBandingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewRubberBandingPropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewRubberBandingPropertyInfo = TreeViewK type AttrGetType TreeViewRubberBandingPropertyInfo = Bool type AttrLabel TreeViewRubberBandingPropertyInfo = "TreeView::rubber-banding" attrGet _ = getTreeViewRubberBanding attrSet _ = setTreeViewRubberBanding attrConstruct _ = constructTreeViewRubberBanding -- VVV Prop "rules-hint" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewRulesHint :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewRulesHint obj = liftIO $ getObjectPropertyBool obj "rules-hint" setTreeViewRulesHint :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewRulesHint obj val = liftIO $ setObjectPropertyBool obj "rules-hint" val constructTreeViewRulesHint :: Bool -> IO ([Char], GValue) constructTreeViewRulesHint val = constructObjectPropertyBool "rules-hint" val data TreeViewRulesHintPropertyInfo instance AttrInfo TreeViewRulesHintPropertyInfo where type AttrAllowedOps TreeViewRulesHintPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewRulesHintPropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewRulesHintPropertyInfo = TreeViewK type AttrGetType TreeViewRulesHintPropertyInfo = Bool type AttrLabel TreeViewRulesHintPropertyInfo = "TreeView::rules-hint" attrGet _ = getTreeViewRulesHint attrSet _ = setTreeViewRulesHint attrConstruct _ = constructTreeViewRulesHint -- VVV Prop "search-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTreeViewSearchColumn :: (MonadIO m, TreeViewK o) => o -> m Int32 getTreeViewSearchColumn obj = liftIO $ getObjectPropertyCInt obj "search-column" setTreeViewSearchColumn :: (MonadIO m, TreeViewK o) => o -> Int32 -> m () setTreeViewSearchColumn obj val = liftIO $ setObjectPropertyCInt obj "search-column" val constructTreeViewSearchColumn :: Int32 -> IO ([Char], GValue) constructTreeViewSearchColumn val = constructObjectPropertyCInt "search-column" val data TreeViewSearchColumnPropertyInfo instance AttrInfo TreeViewSearchColumnPropertyInfo where type AttrAllowedOps TreeViewSearchColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewSearchColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TreeViewSearchColumnPropertyInfo = TreeViewK type AttrGetType TreeViewSearchColumnPropertyInfo = Int32 type AttrLabel TreeViewSearchColumnPropertyInfo = "TreeView::search-column" attrGet _ = getTreeViewSearchColumn attrSet _ = setTreeViewSearchColumn attrConstruct _ = constructTreeViewSearchColumn -- VVV Prop "show-expanders" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewShowExpanders :: (MonadIO m, TreeViewK o) => o -> m Bool getTreeViewShowExpanders obj = liftIO $ getObjectPropertyBool obj "show-expanders" setTreeViewShowExpanders :: (MonadIO m, TreeViewK o) => o -> Bool -> m () setTreeViewShowExpanders obj val = liftIO $ setObjectPropertyBool obj "show-expanders" val constructTreeViewShowExpanders :: Bool -> IO ([Char], GValue) constructTreeViewShowExpanders val = constructObjectPropertyBool "show-expanders" val data TreeViewShowExpandersPropertyInfo instance AttrInfo TreeViewShowExpandersPropertyInfo where type AttrAllowedOps TreeViewShowExpandersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewShowExpandersPropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewShowExpandersPropertyInfo = TreeViewK type AttrGetType TreeViewShowExpandersPropertyInfo = Bool type AttrLabel TreeViewShowExpandersPropertyInfo = "TreeView::show-expanders" attrGet _ = getTreeViewShowExpanders attrSet _ = setTreeViewShowExpanders attrConstruct _ = constructTreeViewShowExpanders -- VVV Prop "tooltip-column" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTreeViewTooltipColumn :: (MonadIO m, TreeViewK o) => o -> m Int32 getTreeViewTooltipColumn obj = liftIO $ getObjectPropertyCInt obj "tooltip-column" setTreeViewTooltipColumn :: (MonadIO m, TreeViewK o) => o -> Int32 -> m () setTreeViewTooltipColumn obj val = liftIO $ setObjectPropertyCInt obj "tooltip-column" val constructTreeViewTooltipColumn :: Int32 -> IO ([Char], GValue) constructTreeViewTooltipColumn val = constructObjectPropertyCInt "tooltip-column" val data TreeViewTooltipColumnPropertyInfo instance AttrInfo TreeViewTooltipColumnPropertyInfo where type AttrAllowedOps TreeViewTooltipColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewTooltipColumnPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TreeViewTooltipColumnPropertyInfo = TreeViewK type AttrGetType TreeViewTooltipColumnPropertyInfo = Int32 type AttrLabel TreeViewTooltipColumnPropertyInfo = "TreeView::tooltip-column" attrGet _ = getTreeViewTooltipColumn attrSet _ = setTreeViewTooltipColumn attrConstruct _ = constructTreeViewTooltipColumn type instance AttributeList TreeView = '[ '("activate-on-single-click", TreeViewActivateOnSingleClickPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("enable-grid-lines", TreeViewEnableGridLinesPropertyInfo), '("enable-search", TreeViewEnableSearchPropertyInfo), '("enable-tree-lines", TreeViewEnableTreeLinesPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("expander-column", TreeViewExpanderColumnPropertyInfo), '("fixed-height-mode", TreeViewFixedHeightModePropertyInfo), '("hadjustment", ScrollableHadjustmentPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("headers-clickable", TreeViewHeadersClickablePropertyInfo), '("headers-visible", TreeViewHeadersVisiblePropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hover-expand", TreeViewHoverExpandPropertyInfo), '("hover-selection", TreeViewHoverSelectionPropertyInfo), '("hscroll-policy", ScrollableHscrollPolicyPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("level-indentation", TreeViewLevelIndentationPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("model", TreeViewModelPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("reorderable", TreeViewReorderablePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("rubber-banding", TreeViewRubberBandingPropertyInfo), '("rules-hint", TreeViewRulesHintPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("search-column", TreeViewSearchColumnPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-expanders", TreeViewShowExpandersPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-column", TreeViewTooltipColumnPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("vadjustment", ScrollableVadjustmentPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("vscroll-policy", ScrollableVscrollPolicyPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList TreeViewAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "alignment" -- Type: TBasicType TFloat -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnAlignment :: (MonadIO m, TreeViewColumnK o) => o -> m Float getTreeViewColumnAlignment obj = liftIO $ getObjectPropertyFloat obj "alignment" setTreeViewColumnAlignment :: (MonadIO m, TreeViewColumnK o) => o -> Float -> m () setTreeViewColumnAlignment obj val = liftIO $ setObjectPropertyFloat obj "alignment" val constructTreeViewColumnAlignment :: Float -> IO ([Char], GValue) constructTreeViewColumnAlignment val = constructObjectPropertyFloat "alignment" val data TreeViewColumnAlignmentPropertyInfo instance AttrInfo TreeViewColumnAlignmentPropertyInfo where type AttrAllowedOps TreeViewColumnAlignmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnAlignmentPropertyInfo = (~) Float type AttrBaseTypeConstraint TreeViewColumnAlignmentPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnAlignmentPropertyInfo = Float type AttrLabel TreeViewColumnAlignmentPropertyInfo = "TreeViewColumn::alignment" attrGet _ = getTreeViewColumnAlignment attrSet _ = setTreeViewColumnAlignment attrConstruct _ = constructTreeViewColumnAlignment -- VVV Prop "cell-area" -- Type: TInterface "Gtk" "CellArea" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTreeViewColumnCellArea :: (MonadIO m, TreeViewColumnK o) => o -> m CellArea getTreeViewColumnCellArea obj = liftIO $ getObjectPropertyObject obj "cell-area" CellArea constructTreeViewColumnCellArea :: (CellAreaK a) => a -> IO ([Char], GValue) constructTreeViewColumnCellArea val = constructObjectPropertyObject "cell-area" val data TreeViewColumnCellAreaPropertyInfo instance AttrInfo TreeViewColumnCellAreaPropertyInfo where type AttrAllowedOps TreeViewColumnCellAreaPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnCellAreaPropertyInfo = CellAreaK type AttrBaseTypeConstraint TreeViewColumnCellAreaPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnCellAreaPropertyInfo = CellArea type AttrLabel TreeViewColumnCellAreaPropertyInfo = "TreeViewColumn::cell-area" attrGet _ = getTreeViewColumnCellArea attrSet _ = undefined attrConstruct _ = constructTreeViewColumnCellArea -- VVV Prop "clickable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnClickable :: (MonadIO m, TreeViewColumnK o) => o -> m Bool getTreeViewColumnClickable obj = liftIO $ getObjectPropertyBool obj "clickable" setTreeViewColumnClickable :: (MonadIO m, TreeViewColumnK o) => o -> Bool -> m () setTreeViewColumnClickable obj val = liftIO $ setObjectPropertyBool obj "clickable" val constructTreeViewColumnClickable :: Bool -> IO ([Char], GValue) constructTreeViewColumnClickable val = constructObjectPropertyBool "clickable" val data TreeViewColumnClickablePropertyInfo instance AttrInfo TreeViewColumnClickablePropertyInfo where type AttrAllowedOps TreeViewColumnClickablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnClickablePropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewColumnClickablePropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnClickablePropertyInfo = Bool type AttrLabel TreeViewColumnClickablePropertyInfo = "TreeViewColumn::clickable" attrGet _ = getTreeViewColumnClickable attrSet _ = setTreeViewColumnClickable attrConstruct _ = constructTreeViewColumnClickable -- VVV Prop "expand" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnExpand :: (MonadIO m, TreeViewColumnK o) => o -> m Bool getTreeViewColumnExpand obj = liftIO $ getObjectPropertyBool obj "expand" setTreeViewColumnExpand :: (MonadIO m, TreeViewColumnK o) => o -> Bool -> m () setTreeViewColumnExpand obj val = liftIO $ setObjectPropertyBool obj "expand" val constructTreeViewColumnExpand :: Bool -> IO ([Char], GValue) constructTreeViewColumnExpand val = constructObjectPropertyBool "expand" val data TreeViewColumnExpandPropertyInfo instance AttrInfo TreeViewColumnExpandPropertyInfo where type AttrAllowedOps TreeViewColumnExpandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnExpandPropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewColumnExpandPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnExpandPropertyInfo = Bool type AttrLabel TreeViewColumnExpandPropertyInfo = "TreeViewColumn::expand" attrGet _ = getTreeViewColumnExpand attrSet _ = setTreeViewColumnExpand attrConstruct _ = constructTreeViewColumnExpand -- VVV Prop "fixed-width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnFixedWidth :: (MonadIO m, TreeViewColumnK o) => o -> m Int32 getTreeViewColumnFixedWidth obj = liftIO $ getObjectPropertyCInt obj "fixed-width" setTreeViewColumnFixedWidth :: (MonadIO m, TreeViewColumnK o) => o -> Int32 -> m () setTreeViewColumnFixedWidth obj val = liftIO $ setObjectPropertyCInt obj "fixed-width" val constructTreeViewColumnFixedWidth :: Int32 -> IO ([Char], GValue) constructTreeViewColumnFixedWidth val = constructObjectPropertyCInt "fixed-width" val data TreeViewColumnFixedWidthPropertyInfo instance AttrInfo TreeViewColumnFixedWidthPropertyInfo where type AttrAllowedOps TreeViewColumnFixedWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnFixedWidthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TreeViewColumnFixedWidthPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnFixedWidthPropertyInfo = Int32 type AttrLabel TreeViewColumnFixedWidthPropertyInfo = "TreeViewColumn::fixed-width" attrGet _ = getTreeViewColumnFixedWidth attrSet _ = setTreeViewColumnFixedWidth attrConstruct _ = constructTreeViewColumnFixedWidth -- VVV Prop "max-width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnMaxWidth :: (MonadIO m, TreeViewColumnK o) => o -> m Int32 getTreeViewColumnMaxWidth obj = liftIO $ getObjectPropertyCInt obj "max-width" setTreeViewColumnMaxWidth :: (MonadIO m, TreeViewColumnK o) => o -> Int32 -> m () setTreeViewColumnMaxWidth obj val = liftIO $ setObjectPropertyCInt obj "max-width" val constructTreeViewColumnMaxWidth :: Int32 -> IO ([Char], GValue) constructTreeViewColumnMaxWidth val = constructObjectPropertyCInt "max-width" val data TreeViewColumnMaxWidthPropertyInfo instance AttrInfo TreeViewColumnMaxWidthPropertyInfo where type AttrAllowedOps TreeViewColumnMaxWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnMaxWidthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TreeViewColumnMaxWidthPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnMaxWidthPropertyInfo = Int32 type AttrLabel TreeViewColumnMaxWidthPropertyInfo = "TreeViewColumn::max-width" attrGet _ = getTreeViewColumnMaxWidth attrSet _ = setTreeViewColumnMaxWidth attrConstruct _ = constructTreeViewColumnMaxWidth -- VVV Prop "min-width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnMinWidth :: (MonadIO m, TreeViewColumnK o) => o -> m Int32 getTreeViewColumnMinWidth obj = liftIO $ getObjectPropertyCInt obj "min-width" setTreeViewColumnMinWidth :: (MonadIO m, TreeViewColumnK o) => o -> Int32 -> m () setTreeViewColumnMinWidth obj val = liftIO $ setObjectPropertyCInt obj "min-width" val constructTreeViewColumnMinWidth :: Int32 -> IO ([Char], GValue) constructTreeViewColumnMinWidth val = constructObjectPropertyCInt "min-width" val data TreeViewColumnMinWidthPropertyInfo instance AttrInfo TreeViewColumnMinWidthPropertyInfo where type AttrAllowedOps TreeViewColumnMinWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnMinWidthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TreeViewColumnMinWidthPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnMinWidthPropertyInfo = Int32 type AttrLabel TreeViewColumnMinWidthPropertyInfo = "TreeViewColumn::min-width" attrGet _ = getTreeViewColumnMinWidth attrSet _ = setTreeViewColumnMinWidth attrConstruct _ = constructTreeViewColumnMinWidth -- VVV Prop "reorderable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnReorderable :: (MonadIO m, TreeViewColumnK o) => o -> m Bool getTreeViewColumnReorderable obj = liftIO $ getObjectPropertyBool obj "reorderable" setTreeViewColumnReorderable :: (MonadIO m, TreeViewColumnK o) => o -> Bool -> m () setTreeViewColumnReorderable obj val = liftIO $ setObjectPropertyBool obj "reorderable" val constructTreeViewColumnReorderable :: Bool -> IO ([Char], GValue) constructTreeViewColumnReorderable val = constructObjectPropertyBool "reorderable" val data TreeViewColumnReorderablePropertyInfo instance AttrInfo TreeViewColumnReorderablePropertyInfo where type AttrAllowedOps TreeViewColumnReorderablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnReorderablePropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewColumnReorderablePropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnReorderablePropertyInfo = Bool type AttrLabel TreeViewColumnReorderablePropertyInfo = "TreeViewColumn::reorderable" attrGet _ = getTreeViewColumnReorderable attrSet _ = setTreeViewColumnReorderable attrConstruct _ = constructTreeViewColumnReorderable -- VVV Prop "resizable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnResizable :: (MonadIO m, TreeViewColumnK o) => o -> m Bool getTreeViewColumnResizable obj = liftIO $ getObjectPropertyBool obj "resizable" setTreeViewColumnResizable :: (MonadIO m, TreeViewColumnK o) => o -> Bool -> m () setTreeViewColumnResizable obj val = liftIO $ setObjectPropertyBool obj "resizable" val constructTreeViewColumnResizable :: Bool -> IO ([Char], GValue) constructTreeViewColumnResizable val = constructObjectPropertyBool "resizable" val data TreeViewColumnResizablePropertyInfo instance AttrInfo TreeViewColumnResizablePropertyInfo where type AttrAllowedOps TreeViewColumnResizablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnResizablePropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewColumnResizablePropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnResizablePropertyInfo = Bool type AttrLabel TreeViewColumnResizablePropertyInfo = "TreeViewColumn::resizable" attrGet _ = getTreeViewColumnResizable attrSet _ = setTreeViewColumnResizable attrConstruct _ = constructTreeViewColumnResizable -- VVV Prop "sizing" -- Type: TInterface "Gtk" "TreeViewColumnSizing" -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnSizing :: (MonadIO m, TreeViewColumnK o) => o -> m TreeViewColumnSizing getTreeViewColumnSizing obj = liftIO $ getObjectPropertyEnum obj "sizing" setTreeViewColumnSizing :: (MonadIO m, TreeViewColumnK o) => o -> TreeViewColumnSizing -> m () setTreeViewColumnSizing obj val = liftIO $ setObjectPropertyEnum obj "sizing" val constructTreeViewColumnSizing :: TreeViewColumnSizing -> IO ([Char], GValue) constructTreeViewColumnSizing val = constructObjectPropertyEnum "sizing" val data TreeViewColumnSizingPropertyInfo instance AttrInfo TreeViewColumnSizingPropertyInfo where type AttrAllowedOps TreeViewColumnSizingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnSizingPropertyInfo = (~) TreeViewColumnSizing type AttrBaseTypeConstraint TreeViewColumnSizingPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnSizingPropertyInfo = TreeViewColumnSizing type AttrLabel TreeViewColumnSizingPropertyInfo = "TreeViewColumn::sizing" attrGet _ = getTreeViewColumnSizing attrSet _ = setTreeViewColumnSizing attrConstruct _ = constructTreeViewColumnSizing -- VVV Prop "sort-column-id" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnSortColumnId :: (MonadIO m, TreeViewColumnK o) => o -> m Int32 getTreeViewColumnSortColumnId obj = liftIO $ getObjectPropertyCInt obj "sort-column-id" setTreeViewColumnSortColumnId :: (MonadIO m, TreeViewColumnK o) => o -> Int32 -> m () setTreeViewColumnSortColumnId obj val = liftIO $ setObjectPropertyCInt obj "sort-column-id" val constructTreeViewColumnSortColumnId :: Int32 -> IO ([Char], GValue) constructTreeViewColumnSortColumnId val = constructObjectPropertyCInt "sort-column-id" val data TreeViewColumnSortColumnIdPropertyInfo instance AttrInfo TreeViewColumnSortColumnIdPropertyInfo where type AttrAllowedOps TreeViewColumnSortColumnIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnSortColumnIdPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TreeViewColumnSortColumnIdPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnSortColumnIdPropertyInfo = Int32 type AttrLabel TreeViewColumnSortColumnIdPropertyInfo = "TreeViewColumn::sort-column-id" attrGet _ = getTreeViewColumnSortColumnId attrSet _ = setTreeViewColumnSortColumnId attrConstruct _ = constructTreeViewColumnSortColumnId -- VVV Prop "sort-indicator" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnSortIndicator :: (MonadIO m, TreeViewColumnK o) => o -> m Bool getTreeViewColumnSortIndicator obj = liftIO $ getObjectPropertyBool obj "sort-indicator" setTreeViewColumnSortIndicator :: (MonadIO m, TreeViewColumnK o) => o -> Bool -> m () setTreeViewColumnSortIndicator obj val = liftIO $ setObjectPropertyBool obj "sort-indicator" val constructTreeViewColumnSortIndicator :: Bool -> IO ([Char], GValue) constructTreeViewColumnSortIndicator val = constructObjectPropertyBool "sort-indicator" val data TreeViewColumnSortIndicatorPropertyInfo instance AttrInfo TreeViewColumnSortIndicatorPropertyInfo where type AttrAllowedOps TreeViewColumnSortIndicatorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnSortIndicatorPropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewColumnSortIndicatorPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnSortIndicatorPropertyInfo = Bool type AttrLabel TreeViewColumnSortIndicatorPropertyInfo = "TreeViewColumn::sort-indicator" attrGet _ = getTreeViewColumnSortIndicator attrSet _ = setTreeViewColumnSortIndicator attrConstruct _ = constructTreeViewColumnSortIndicator -- VVV Prop "sort-order" -- Type: TInterface "Gtk" "SortType" -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnSortOrder :: (MonadIO m, TreeViewColumnK o) => o -> m SortType getTreeViewColumnSortOrder obj = liftIO $ getObjectPropertyEnum obj "sort-order" setTreeViewColumnSortOrder :: (MonadIO m, TreeViewColumnK o) => o -> SortType -> m () setTreeViewColumnSortOrder obj val = liftIO $ setObjectPropertyEnum obj "sort-order" val constructTreeViewColumnSortOrder :: SortType -> IO ([Char], GValue) constructTreeViewColumnSortOrder val = constructObjectPropertyEnum "sort-order" val data TreeViewColumnSortOrderPropertyInfo instance AttrInfo TreeViewColumnSortOrderPropertyInfo where type AttrAllowedOps TreeViewColumnSortOrderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnSortOrderPropertyInfo = (~) SortType type AttrBaseTypeConstraint TreeViewColumnSortOrderPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnSortOrderPropertyInfo = SortType type AttrLabel TreeViewColumnSortOrderPropertyInfo = "TreeViewColumn::sort-order" attrGet _ = getTreeViewColumnSortOrder attrSet _ = setTreeViewColumnSortOrder attrConstruct _ = constructTreeViewColumnSortOrder -- VVV Prop "spacing" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnSpacing :: (MonadIO m, TreeViewColumnK o) => o -> m Int32 getTreeViewColumnSpacing obj = liftIO $ getObjectPropertyCInt obj "spacing" setTreeViewColumnSpacing :: (MonadIO m, TreeViewColumnK o) => o -> Int32 -> m () setTreeViewColumnSpacing obj val = liftIO $ setObjectPropertyCInt obj "spacing" val constructTreeViewColumnSpacing :: Int32 -> IO ([Char], GValue) constructTreeViewColumnSpacing val = constructObjectPropertyCInt "spacing" val data TreeViewColumnSpacingPropertyInfo instance AttrInfo TreeViewColumnSpacingPropertyInfo where type AttrAllowedOps TreeViewColumnSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnSpacingPropertyInfo = (~) Int32 type AttrBaseTypeConstraint TreeViewColumnSpacingPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnSpacingPropertyInfo = Int32 type AttrLabel TreeViewColumnSpacingPropertyInfo = "TreeViewColumn::spacing" attrGet _ = getTreeViewColumnSpacing attrSet _ = setTreeViewColumnSpacing attrConstruct _ = constructTreeViewColumnSpacing -- VVV Prop "title" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnTitle :: (MonadIO m, TreeViewColumnK o) => o -> m T.Text getTreeViewColumnTitle obj = liftIO $ getObjectPropertyString obj "title" setTreeViewColumnTitle :: (MonadIO m, TreeViewColumnK o) => o -> T.Text -> m () setTreeViewColumnTitle obj val = liftIO $ setObjectPropertyString obj "title" val constructTreeViewColumnTitle :: T.Text -> IO ([Char], GValue) constructTreeViewColumnTitle val = constructObjectPropertyString "title" val data TreeViewColumnTitlePropertyInfo instance AttrInfo TreeViewColumnTitlePropertyInfo where type AttrAllowedOps TreeViewColumnTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnTitlePropertyInfo = (~) T.Text type AttrBaseTypeConstraint TreeViewColumnTitlePropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnTitlePropertyInfo = T.Text type AttrLabel TreeViewColumnTitlePropertyInfo = "TreeViewColumn::title" attrGet _ = getTreeViewColumnTitle attrSet _ = setTreeViewColumnTitle attrConstruct _ = constructTreeViewColumnTitle -- VVV Prop "visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnVisible :: (MonadIO m, TreeViewColumnK o) => o -> m Bool getTreeViewColumnVisible obj = liftIO $ getObjectPropertyBool obj "visible" setTreeViewColumnVisible :: (MonadIO m, TreeViewColumnK o) => o -> Bool -> m () setTreeViewColumnVisible obj val = liftIO $ setObjectPropertyBool obj "visible" val constructTreeViewColumnVisible :: Bool -> IO ([Char], GValue) constructTreeViewColumnVisible val = constructObjectPropertyBool "visible" val data TreeViewColumnVisiblePropertyInfo instance AttrInfo TreeViewColumnVisiblePropertyInfo where type AttrAllowedOps TreeViewColumnVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnVisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint TreeViewColumnVisiblePropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnVisiblePropertyInfo = Bool type AttrLabel TreeViewColumnVisiblePropertyInfo = "TreeViewColumn::visible" attrGet _ = getTreeViewColumnVisible attrSet _ = setTreeViewColumnVisible attrConstruct _ = constructTreeViewColumnVisible -- VVV Prop "widget" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable] getTreeViewColumnWidget :: (MonadIO m, TreeViewColumnK o) => o -> m Widget getTreeViewColumnWidget obj = liftIO $ getObjectPropertyObject obj "widget" Widget setTreeViewColumnWidget :: (MonadIO m, TreeViewColumnK o, WidgetK a) => o -> a -> m () setTreeViewColumnWidget obj val = liftIO $ setObjectPropertyObject obj "widget" val constructTreeViewColumnWidget :: (WidgetK a) => a -> IO ([Char], GValue) constructTreeViewColumnWidget val = constructObjectPropertyObject "widget" val data TreeViewColumnWidgetPropertyInfo instance AttrInfo TreeViewColumnWidgetPropertyInfo where type AttrAllowedOps TreeViewColumnWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TreeViewColumnWidgetPropertyInfo = WidgetK type AttrBaseTypeConstraint TreeViewColumnWidgetPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnWidgetPropertyInfo = Widget type AttrLabel TreeViewColumnWidgetPropertyInfo = "TreeViewColumn::widget" attrGet _ = getTreeViewColumnWidget attrSet _ = setTreeViewColumnWidget attrConstruct _ = constructTreeViewColumnWidget -- VVV Prop "width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getTreeViewColumnWidth :: (MonadIO m, TreeViewColumnK o) => o -> m Int32 getTreeViewColumnWidth obj = liftIO $ getObjectPropertyCInt obj "width" data TreeViewColumnWidthPropertyInfo instance AttrInfo TreeViewColumnWidthPropertyInfo where type AttrAllowedOps TreeViewColumnWidthPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint TreeViewColumnWidthPropertyInfo = (~) () type AttrBaseTypeConstraint TreeViewColumnWidthPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnWidthPropertyInfo = Int32 type AttrLabel TreeViewColumnWidthPropertyInfo = "TreeViewColumn::width" attrGet _ = getTreeViewColumnWidth attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "x-offset" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getTreeViewColumnXOffset :: (MonadIO m, TreeViewColumnK o) => o -> m Int32 getTreeViewColumnXOffset obj = liftIO $ getObjectPropertyCInt obj "x-offset" data TreeViewColumnXOffsetPropertyInfo instance AttrInfo TreeViewColumnXOffsetPropertyInfo where type AttrAllowedOps TreeViewColumnXOffsetPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint TreeViewColumnXOffsetPropertyInfo = (~) () type AttrBaseTypeConstraint TreeViewColumnXOffsetPropertyInfo = TreeViewColumnK type AttrGetType TreeViewColumnXOffsetPropertyInfo = Int32 type AttrLabel TreeViewColumnXOffsetPropertyInfo = "TreeViewColumn::x-offset" attrGet _ = getTreeViewColumnXOffset attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList TreeViewColumn = '[ '("alignment", TreeViewColumnAlignmentPropertyInfo), '("cell-area", TreeViewColumnCellAreaPropertyInfo), '("clickable", TreeViewColumnClickablePropertyInfo), '("expand", TreeViewColumnExpandPropertyInfo), '("fixed-width", TreeViewColumnFixedWidthPropertyInfo), '("max-width", TreeViewColumnMaxWidthPropertyInfo), '("min-width", TreeViewColumnMinWidthPropertyInfo), '("reorderable", TreeViewColumnReorderablePropertyInfo), '("resizable", TreeViewColumnResizablePropertyInfo), '("sizing", TreeViewColumnSizingPropertyInfo), '("sort-column-id", TreeViewColumnSortColumnIdPropertyInfo), '("sort-indicator", TreeViewColumnSortIndicatorPropertyInfo), '("sort-order", TreeViewColumnSortOrderPropertyInfo), '("spacing", TreeViewColumnSpacingPropertyInfo), '("title", TreeViewColumnTitlePropertyInfo), '("visible", TreeViewColumnVisiblePropertyInfo), '("widget", TreeViewColumnWidgetPropertyInfo), '("width", TreeViewColumnWidthPropertyInfo), '("x-offset", TreeViewColumnXOffsetPropertyInfo)] -- VVV Prop "add-tearoffs" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getUIManagerAddTearoffs :: (MonadIO m, UIManagerK o) => o -> m Bool getUIManagerAddTearoffs obj = liftIO $ getObjectPropertyBool obj "add-tearoffs" setUIManagerAddTearoffs :: (MonadIO m, UIManagerK o) => o -> Bool -> m () setUIManagerAddTearoffs obj val = liftIO $ setObjectPropertyBool obj "add-tearoffs" val constructUIManagerAddTearoffs :: Bool -> IO ([Char], GValue) constructUIManagerAddTearoffs val = constructObjectPropertyBool "add-tearoffs" val data UIManagerAddTearoffsPropertyInfo instance AttrInfo UIManagerAddTearoffsPropertyInfo where type AttrAllowedOps UIManagerAddTearoffsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UIManagerAddTearoffsPropertyInfo = (~) Bool type AttrBaseTypeConstraint UIManagerAddTearoffsPropertyInfo = UIManagerK type AttrGetType UIManagerAddTearoffsPropertyInfo = Bool type AttrLabel UIManagerAddTearoffsPropertyInfo = "UIManager::add-tearoffs" attrGet _ = getUIManagerAddTearoffs attrSet _ = setUIManagerAddTearoffs attrConstruct _ = constructUIManagerAddTearoffs -- VVV Prop "ui" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable] getUIManagerUi :: (MonadIO m, UIManagerK o) => o -> m T.Text getUIManagerUi obj = liftIO $ getObjectPropertyString obj "ui" data UIManagerUiPropertyInfo instance AttrInfo UIManagerUiPropertyInfo where type AttrAllowedOps UIManagerUiPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint UIManagerUiPropertyInfo = (~) () type AttrBaseTypeConstraint UIManagerUiPropertyInfo = UIManagerK type AttrGetType UIManagerUiPropertyInfo = T.Text type AttrLabel UIManagerUiPropertyInfo = "UIManager::ui" attrGet _ = getUIManagerUi attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList UIManager = '[ '("add-tearoffs", UIManagerAddTearoffsPropertyInfo), '("ui", UIManagerUiPropertyInfo)] type instance AttributeList VBox = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList VButtonBox = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("baseline-position", BoxBaselinePositionPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("homogeneous", BoxHomogeneousPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("layout-style", ButtonBoxLayoutStylePropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("spacing", BoxSpacingPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList VPaned = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-position", PanedMaxPositionPropertyInfo), '("min-position", PanedMinPositionPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("position", PanedPositionPropertyInfo), '("position-set", PanedPositionSetPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("wide-handle", PanedWideHandlePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList VScale = '[ '("adjustment", RangeAdjustmentPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("digits", ScaleDigitsPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-value", ScaleDrawValuePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("fill-level", RangeFillLevelPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-origin", ScaleHasOriginPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inverted", RangeInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("lower-stepper-sensitivity", RangeLowerStepperSensitivityPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("restrict-to-fill-level", RangeRestrictToFillLevelPropertyInfo), '("round-digits", RangeRoundDigitsPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-fill-level", RangeShowFillLevelPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("upper-stepper-sensitivity", RangeUpperStepperSensitivityPropertyInfo), '("valign", WidgetValignPropertyInfo), '("value-pos", ScaleValuePosPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList VScrollbar = '[ '("adjustment", RangeAdjustmentPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("fill-level", RangeFillLevelPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inverted", RangeInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("lower-stepper-sensitivity", RangeLowerStepperSensitivityPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("restrict-to-fill-level", RangeRestrictToFillLevelPropertyInfo), '("round-digits", RangeRoundDigitsPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-fill-level", RangeShowFillLevelPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("upper-stepper-sensitivity", RangeUpperStepperSensitivityPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList VSeparator = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "shadow-type" -- Type: TInterface "Gtk" "ShadowType" -- Flags: [PropertyReadable,PropertyWritable] getViewportShadowType :: (MonadIO m, ViewportK o) => o -> m ShadowType getViewportShadowType obj = liftIO $ getObjectPropertyEnum obj "shadow-type" setViewportShadowType :: (MonadIO m, ViewportK o) => o -> ShadowType -> m () setViewportShadowType obj val = liftIO $ setObjectPropertyEnum obj "shadow-type" val constructViewportShadowType :: ShadowType -> IO ([Char], GValue) constructViewportShadowType val = constructObjectPropertyEnum "shadow-type" val data ViewportShadowTypePropertyInfo instance AttrInfo ViewportShadowTypePropertyInfo where type AttrAllowedOps ViewportShadowTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ViewportShadowTypePropertyInfo = (~) ShadowType type AttrBaseTypeConstraint ViewportShadowTypePropertyInfo = ViewportK type AttrGetType ViewportShadowTypePropertyInfo = ShadowType type AttrLabel ViewportShadowTypePropertyInfo = "Viewport::shadow-type" attrGet _ = getViewportShadowType attrSet _ = setViewportShadowType attrConstruct _ = constructViewportShadowType type instance AttributeList Viewport = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("hadjustment", ScrollableHadjustmentPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hscroll-policy", ScrollableHscrollPolicyPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", ViewportShadowTypePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("vadjustment", ScrollableVadjustmentPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("vscroll-policy", ScrollableVscrollPolicyPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] -- VVV Prop "use-symbolic" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getVolumeButtonUseSymbolic :: (MonadIO m, VolumeButtonK o) => o -> m Bool getVolumeButtonUseSymbolic obj = liftIO $ getObjectPropertyBool obj "use-symbolic" setVolumeButtonUseSymbolic :: (MonadIO m, VolumeButtonK o) => o -> Bool -> m () setVolumeButtonUseSymbolic obj val = liftIO $ setObjectPropertyBool obj "use-symbolic" val constructVolumeButtonUseSymbolic :: Bool -> IO ([Char], GValue) constructVolumeButtonUseSymbolic val = constructObjectPropertyBool "use-symbolic" val data VolumeButtonUseSymbolicPropertyInfo instance AttrInfo VolumeButtonUseSymbolicPropertyInfo where type AttrAllowedOps VolumeButtonUseSymbolicPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint VolumeButtonUseSymbolicPropertyInfo = (~) Bool type AttrBaseTypeConstraint VolumeButtonUseSymbolicPropertyInfo = VolumeButtonK type AttrGetType VolumeButtonUseSymbolicPropertyInfo = Bool type AttrLabel VolumeButtonUseSymbolicPropertyInfo = "VolumeButton::use-symbolic" attrGet _ = getVolumeButtonUseSymbolic attrSet _ = setVolumeButtonUseSymbolic attrConstruct _ = constructVolumeButtonUseSymbolic type instance AttributeList VolumeButton = '[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("adjustment", ScaleButtonAdjustmentPropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("icons", ScaleButtonIconsPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("size", ScaleButtonSizePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-symbolic", VolumeButtonUseSymbolicPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("value", ScaleButtonValuePropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] -- VVV Prop "app-paintable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetAppPaintable :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetAppPaintable obj = liftIO $ getObjectPropertyBool obj "app-paintable" setWidgetAppPaintable :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetAppPaintable obj val = liftIO $ setObjectPropertyBool obj "app-paintable" val constructWidgetAppPaintable :: Bool -> IO ([Char], GValue) constructWidgetAppPaintable val = constructObjectPropertyBool "app-paintable" val data WidgetAppPaintablePropertyInfo instance AttrInfo WidgetAppPaintablePropertyInfo where type AttrAllowedOps WidgetAppPaintablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetAppPaintablePropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetAppPaintablePropertyInfo = WidgetK type AttrGetType WidgetAppPaintablePropertyInfo = Bool type AttrLabel WidgetAppPaintablePropertyInfo = "Widget::app-paintable" attrGet _ = getWidgetAppPaintable attrSet _ = setWidgetAppPaintable attrConstruct _ = constructWidgetAppPaintable -- VVV Prop "can-default" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetCanDefault :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetCanDefault obj = liftIO $ getObjectPropertyBool obj "can-default" setWidgetCanDefault :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetCanDefault obj val = liftIO $ setObjectPropertyBool obj "can-default" val constructWidgetCanDefault :: Bool -> IO ([Char], GValue) constructWidgetCanDefault val = constructObjectPropertyBool "can-default" val data WidgetCanDefaultPropertyInfo instance AttrInfo WidgetCanDefaultPropertyInfo where type AttrAllowedOps WidgetCanDefaultPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetCanDefaultPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetCanDefaultPropertyInfo = WidgetK type AttrGetType WidgetCanDefaultPropertyInfo = Bool type AttrLabel WidgetCanDefaultPropertyInfo = "Widget::can-default" attrGet _ = getWidgetCanDefault attrSet _ = setWidgetCanDefault attrConstruct _ = constructWidgetCanDefault -- VVV Prop "can-focus" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetCanFocus :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetCanFocus obj = liftIO $ getObjectPropertyBool obj "can-focus" setWidgetCanFocus :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetCanFocus obj val = liftIO $ setObjectPropertyBool obj "can-focus" val constructWidgetCanFocus :: Bool -> IO ([Char], GValue) constructWidgetCanFocus val = constructObjectPropertyBool "can-focus" val data WidgetCanFocusPropertyInfo instance AttrInfo WidgetCanFocusPropertyInfo where type AttrAllowedOps WidgetCanFocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetCanFocusPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetCanFocusPropertyInfo = WidgetK type AttrGetType WidgetCanFocusPropertyInfo = Bool type AttrLabel WidgetCanFocusPropertyInfo = "Widget::can-focus" attrGet _ = getWidgetCanFocus attrSet _ = setWidgetCanFocus attrConstruct _ = constructWidgetCanFocus -- VVV Prop "composite-child" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getWidgetCompositeChild :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetCompositeChild obj = liftIO $ getObjectPropertyBool obj "composite-child" data WidgetCompositeChildPropertyInfo instance AttrInfo WidgetCompositeChildPropertyInfo where type AttrAllowedOps WidgetCompositeChildPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint WidgetCompositeChildPropertyInfo = (~) () type AttrBaseTypeConstraint WidgetCompositeChildPropertyInfo = WidgetK type AttrGetType WidgetCompositeChildPropertyInfo = Bool type AttrLabel WidgetCompositeChildPropertyInfo = "Widget::composite-child" attrGet _ = getWidgetCompositeChild attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "double-buffered" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetDoubleBuffered :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetDoubleBuffered obj = liftIO $ getObjectPropertyBool obj "double-buffered" setWidgetDoubleBuffered :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetDoubleBuffered obj val = liftIO $ setObjectPropertyBool obj "double-buffered" val constructWidgetDoubleBuffered :: Bool -> IO ([Char], GValue) constructWidgetDoubleBuffered val = constructObjectPropertyBool "double-buffered" val data WidgetDoubleBufferedPropertyInfo instance AttrInfo WidgetDoubleBufferedPropertyInfo where type AttrAllowedOps WidgetDoubleBufferedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetDoubleBufferedPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetDoubleBufferedPropertyInfo = WidgetK type AttrGetType WidgetDoubleBufferedPropertyInfo = Bool type AttrLabel WidgetDoubleBufferedPropertyInfo = "Widget::double-buffered" attrGet _ = getWidgetDoubleBuffered attrSet _ = setWidgetDoubleBuffered attrConstruct _ = constructWidgetDoubleBuffered -- VVV Prop "events" -- Type: TInterface "Gdk" "EventMask" -- Flags: [PropertyReadable,PropertyWritable] getWidgetEvents :: (MonadIO m, WidgetK o) => o -> m [Gdk.EventMask] getWidgetEvents obj = liftIO $ getObjectPropertyFlags obj "events" setWidgetEvents :: (MonadIO m, WidgetK o) => o -> [Gdk.EventMask] -> m () setWidgetEvents obj val = liftIO $ setObjectPropertyFlags obj "events" val constructWidgetEvents :: [Gdk.EventMask] -> IO ([Char], GValue) constructWidgetEvents val = constructObjectPropertyFlags "events" val data WidgetEventsPropertyInfo instance AttrInfo WidgetEventsPropertyInfo where type AttrAllowedOps WidgetEventsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetEventsPropertyInfo = (~) [Gdk.EventMask] type AttrBaseTypeConstraint WidgetEventsPropertyInfo = WidgetK type AttrGetType WidgetEventsPropertyInfo = [Gdk.EventMask] type AttrLabel WidgetEventsPropertyInfo = "Widget::events" attrGet _ = getWidgetEvents attrSet _ = setWidgetEvents attrConstruct _ = constructWidgetEvents -- VVV Prop "expand" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetExpand :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetExpand obj = liftIO $ getObjectPropertyBool obj "expand" setWidgetExpand :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetExpand obj val = liftIO $ setObjectPropertyBool obj "expand" val constructWidgetExpand :: Bool -> IO ([Char], GValue) constructWidgetExpand val = constructObjectPropertyBool "expand" val data WidgetExpandPropertyInfo instance AttrInfo WidgetExpandPropertyInfo where type AttrAllowedOps WidgetExpandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetExpandPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetExpandPropertyInfo = WidgetK type AttrGetType WidgetExpandPropertyInfo = Bool type AttrLabel WidgetExpandPropertyInfo = "Widget::expand" attrGet _ = getWidgetExpand attrSet _ = setWidgetExpand attrConstruct _ = constructWidgetExpand -- VVV Prop "halign" -- Type: TInterface "Gtk" "Align" -- Flags: [PropertyReadable,PropertyWritable] getWidgetHalign :: (MonadIO m, WidgetK o) => o -> m Align getWidgetHalign obj = liftIO $ getObjectPropertyEnum obj "halign" setWidgetHalign :: (MonadIO m, WidgetK o) => o -> Align -> m () setWidgetHalign obj val = liftIO $ setObjectPropertyEnum obj "halign" val constructWidgetHalign :: Align -> IO ([Char], GValue) constructWidgetHalign val = constructObjectPropertyEnum "halign" val data WidgetHalignPropertyInfo instance AttrInfo WidgetHalignPropertyInfo where type AttrAllowedOps WidgetHalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetHalignPropertyInfo = (~) Align type AttrBaseTypeConstraint WidgetHalignPropertyInfo = WidgetK type AttrGetType WidgetHalignPropertyInfo = Align type AttrLabel WidgetHalignPropertyInfo = "Widget::halign" attrGet _ = getWidgetHalign attrSet _ = setWidgetHalign attrConstruct _ = constructWidgetHalign -- VVV Prop "has-default" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetHasDefault :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetHasDefault obj = liftIO $ getObjectPropertyBool obj "has-default" setWidgetHasDefault :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetHasDefault obj val = liftIO $ setObjectPropertyBool obj "has-default" val constructWidgetHasDefault :: Bool -> IO ([Char], GValue) constructWidgetHasDefault val = constructObjectPropertyBool "has-default" val data WidgetHasDefaultPropertyInfo instance AttrInfo WidgetHasDefaultPropertyInfo where type AttrAllowedOps WidgetHasDefaultPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetHasDefaultPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetHasDefaultPropertyInfo = WidgetK type AttrGetType WidgetHasDefaultPropertyInfo = Bool type AttrLabel WidgetHasDefaultPropertyInfo = "Widget::has-default" attrGet _ = getWidgetHasDefault attrSet _ = setWidgetHasDefault attrConstruct _ = constructWidgetHasDefault -- VVV Prop "has-focus" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetHasFocus :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetHasFocus obj = liftIO $ getObjectPropertyBool obj "has-focus" setWidgetHasFocus :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetHasFocus obj val = liftIO $ setObjectPropertyBool obj "has-focus" val constructWidgetHasFocus :: Bool -> IO ([Char], GValue) constructWidgetHasFocus val = constructObjectPropertyBool "has-focus" val data WidgetHasFocusPropertyInfo instance AttrInfo WidgetHasFocusPropertyInfo where type AttrAllowedOps WidgetHasFocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetHasFocusPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetHasFocusPropertyInfo = WidgetK type AttrGetType WidgetHasFocusPropertyInfo = Bool type AttrLabel WidgetHasFocusPropertyInfo = "Widget::has-focus" attrGet _ = getWidgetHasFocus attrSet _ = setWidgetHasFocus attrConstruct _ = constructWidgetHasFocus -- VVV Prop "has-tooltip" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetHasTooltip :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetHasTooltip obj = liftIO $ getObjectPropertyBool obj "has-tooltip" setWidgetHasTooltip :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetHasTooltip obj val = liftIO $ setObjectPropertyBool obj "has-tooltip" val constructWidgetHasTooltip :: Bool -> IO ([Char], GValue) constructWidgetHasTooltip val = constructObjectPropertyBool "has-tooltip" val data WidgetHasTooltipPropertyInfo instance AttrInfo WidgetHasTooltipPropertyInfo where type AttrAllowedOps WidgetHasTooltipPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetHasTooltipPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetHasTooltipPropertyInfo = WidgetK type AttrGetType WidgetHasTooltipPropertyInfo = Bool type AttrLabel WidgetHasTooltipPropertyInfo = "Widget::has-tooltip" attrGet _ = getWidgetHasTooltip attrSet _ = setWidgetHasTooltip attrConstruct _ = constructWidgetHasTooltip -- VVV Prop "height-request" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWidgetHeightRequest :: (MonadIO m, WidgetK o) => o -> m Int32 getWidgetHeightRequest obj = liftIO $ getObjectPropertyCInt obj "height-request" setWidgetHeightRequest :: (MonadIO m, WidgetK o) => o -> Int32 -> m () setWidgetHeightRequest obj val = liftIO $ setObjectPropertyCInt obj "height-request" val constructWidgetHeightRequest :: Int32 -> IO ([Char], GValue) constructWidgetHeightRequest val = constructObjectPropertyCInt "height-request" val data WidgetHeightRequestPropertyInfo instance AttrInfo WidgetHeightRequestPropertyInfo where type AttrAllowedOps WidgetHeightRequestPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetHeightRequestPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WidgetHeightRequestPropertyInfo = WidgetK type AttrGetType WidgetHeightRequestPropertyInfo = Int32 type AttrLabel WidgetHeightRequestPropertyInfo = "Widget::height-request" attrGet _ = getWidgetHeightRequest attrSet _ = setWidgetHeightRequest attrConstruct _ = constructWidgetHeightRequest -- VVV Prop "hexpand" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetHexpand :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetHexpand obj = liftIO $ getObjectPropertyBool obj "hexpand" setWidgetHexpand :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetHexpand obj val = liftIO $ setObjectPropertyBool obj "hexpand" val constructWidgetHexpand :: Bool -> IO ([Char], GValue) constructWidgetHexpand val = constructObjectPropertyBool "hexpand" val data WidgetHexpandPropertyInfo instance AttrInfo WidgetHexpandPropertyInfo where type AttrAllowedOps WidgetHexpandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetHexpandPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetHexpandPropertyInfo = WidgetK type AttrGetType WidgetHexpandPropertyInfo = Bool type AttrLabel WidgetHexpandPropertyInfo = "Widget::hexpand" attrGet _ = getWidgetHexpand attrSet _ = setWidgetHexpand attrConstruct _ = constructWidgetHexpand -- VVV Prop "hexpand-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetHexpandSet :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetHexpandSet obj = liftIO $ getObjectPropertyBool obj "hexpand-set" setWidgetHexpandSet :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetHexpandSet obj val = liftIO $ setObjectPropertyBool obj "hexpand-set" val constructWidgetHexpandSet :: Bool -> IO ([Char], GValue) constructWidgetHexpandSet val = constructObjectPropertyBool "hexpand-set" val data WidgetHexpandSetPropertyInfo instance AttrInfo WidgetHexpandSetPropertyInfo where type AttrAllowedOps WidgetHexpandSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetHexpandSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetHexpandSetPropertyInfo = WidgetK type AttrGetType WidgetHexpandSetPropertyInfo = Bool type AttrLabel WidgetHexpandSetPropertyInfo = "Widget::hexpand-set" attrGet _ = getWidgetHexpandSet attrSet _ = setWidgetHexpandSet attrConstruct _ = constructWidgetHexpandSet -- VVV Prop "is-focus" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetIsFocus :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetIsFocus obj = liftIO $ getObjectPropertyBool obj "is-focus" setWidgetIsFocus :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetIsFocus obj val = liftIO $ setObjectPropertyBool obj "is-focus" val constructWidgetIsFocus :: Bool -> IO ([Char], GValue) constructWidgetIsFocus val = constructObjectPropertyBool "is-focus" val data WidgetIsFocusPropertyInfo instance AttrInfo WidgetIsFocusPropertyInfo where type AttrAllowedOps WidgetIsFocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetIsFocusPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetIsFocusPropertyInfo = WidgetK type AttrGetType WidgetIsFocusPropertyInfo = Bool type AttrLabel WidgetIsFocusPropertyInfo = "Widget::is-focus" attrGet _ = getWidgetIsFocus attrSet _ = setWidgetIsFocus attrConstruct _ = constructWidgetIsFocus -- VVV Prop "margin" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWidgetMargin :: (MonadIO m, WidgetK o) => o -> m Int32 getWidgetMargin obj = liftIO $ getObjectPropertyCInt obj "margin" setWidgetMargin :: (MonadIO m, WidgetK o) => o -> Int32 -> m () setWidgetMargin obj val = liftIO $ setObjectPropertyCInt obj "margin" val constructWidgetMargin :: Int32 -> IO ([Char], GValue) constructWidgetMargin val = constructObjectPropertyCInt "margin" val data WidgetMarginPropertyInfo instance AttrInfo WidgetMarginPropertyInfo where type AttrAllowedOps WidgetMarginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetMarginPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WidgetMarginPropertyInfo = WidgetK type AttrGetType WidgetMarginPropertyInfo = Int32 type AttrLabel WidgetMarginPropertyInfo = "Widget::margin" attrGet _ = getWidgetMargin attrSet _ = setWidgetMargin attrConstruct _ = constructWidgetMargin -- VVV Prop "margin-bottom" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWidgetMarginBottom :: (MonadIO m, WidgetK o) => o -> m Int32 getWidgetMarginBottom obj = liftIO $ getObjectPropertyCInt obj "margin-bottom" setWidgetMarginBottom :: (MonadIO m, WidgetK o) => o -> Int32 -> m () setWidgetMarginBottom obj val = liftIO $ setObjectPropertyCInt obj "margin-bottom" val constructWidgetMarginBottom :: Int32 -> IO ([Char], GValue) constructWidgetMarginBottom val = constructObjectPropertyCInt "margin-bottom" val data WidgetMarginBottomPropertyInfo instance AttrInfo WidgetMarginBottomPropertyInfo where type AttrAllowedOps WidgetMarginBottomPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetMarginBottomPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WidgetMarginBottomPropertyInfo = WidgetK type AttrGetType WidgetMarginBottomPropertyInfo = Int32 type AttrLabel WidgetMarginBottomPropertyInfo = "Widget::margin-bottom" attrGet _ = getWidgetMarginBottom attrSet _ = setWidgetMarginBottom attrConstruct _ = constructWidgetMarginBottom -- VVV Prop "margin-end" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWidgetMarginEnd :: (MonadIO m, WidgetK o) => o -> m Int32 getWidgetMarginEnd obj = liftIO $ getObjectPropertyCInt obj "margin-end" setWidgetMarginEnd :: (MonadIO m, WidgetK o) => o -> Int32 -> m () setWidgetMarginEnd obj val = liftIO $ setObjectPropertyCInt obj "margin-end" val constructWidgetMarginEnd :: Int32 -> IO ([Char], GValue) constructWidgetMarginEnd val = constructObjectPropertyCInt "margin-end" val data WidgetMarginEndPropertyInfo instance AttrInfo WidgetMarginEndPropertyInfo where type AttrAllowedOps WidgetMarginEndPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetMarginEndPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WidgetMarginEndPropertyInfo = WidgetK type AttrGetType WidgetMarginEndPropertyInfo = Int32 type AttrLabel WidgetMarginEndPropertyInfo = "Widget::margin-end" attrGet _ = getWidgetMarginEnd attrSet _ = setWidgetMarginEnd attrConstruct _ = constructWidgetMarginEnd -- VVV Prop "margin-left" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWidgetMarginLeft :: (MonadIO m, WidgetK o) => o -> m Int32 getWidgetMarginLeft obj = liftIO $ getObjectPropertyCInt obj "margin-left" setWidgetMarginLeft :: (MonadIO m, WidgetK o) => o -> Int32 -> m () setWidgetMarginLeft obj val = liftIO $ setObjectPropertyCInt obj "margin-left" val constructWidgetMarginLeft :: Int32 -> IO ([Char], GValue) constructWidgetMarginLeft val = constructObjectPropertyCInt "margin-left" val data WidgetMarginLeftPropertyInfo instance AttrInfo WidgetMarginLeftPropertyInfo where type AttrAllowedOps WidgetMarginLeftPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetMarginLeftPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WidgetMarginLeftPropertyInfo = WidgetK type AttrGetType WidgetMarginLeftPropertyInfo = Int32 type AttrLabel WidgetMarginLeftPropertyInfo = "Widget::margin-left" attrGet _ = getWidgetMarginLeft attrSet _ = setWidgetMarginLeft attrConstruct _ = constructWidgetMarginLeft -- VVV Prop "margin-right" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWidgetMarginRight :: (MonadIO m, WidgetK o) => o -> m Int32 getWidgetMarginRight obj = liftIO $ getObjectPropertyCInt obj "margin-right" setWidgetMarginRight :: (MonadIO m, WidgetK o) => o -> Int32 -> m () setWidgetMarginRight obj val = liftIO $ setObjectPropertyCInt obj "margin-right" val constructWidgetMarginRight :: Int32 -> IO ([Char], GValue) constructWidgetMarginRight val = constructObjectPropertyCInt "margin-right" val data WidgetMarginRightPropertyInfo instance AttrInfo WidgetMarginRightPropertyInfo where type AttrAllowedOps WidgetMarginRightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetMarginRightPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WidgetMarginRightPropertyInfo = WidgetK type AttrGetType WidgetMarginRightPropertyInfo = Int32 type AttrLabel WidgetMarginRightPropertyInfo = "Widget::margin-right" attrGet _ = getWidgetMarginRight attrSet _ = setWidgetMarginRight attrConstruct _ = constructWidgetMarginRight -- VVV Prop "margin-start" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWidgetMarginStart :: (MonadIO m, WidgetK o) => o -> m Int32 getWidgetMarginStart obj = liftIO $ getObjectPropertyCInt obj "margin-start" setWidgetMarginStart :: (MonadIO m, WidgetK o) => o -> Int32 -> m () setWidgetMarginStart obj val = liftIO $ setObjectPropertyCInt obj "margin-start" val constructWidgetMarginStart :: Int32 -> IO ([Char], GValue) constructWidgetMarginStart val = constructObjectPropertyCInt "margin-start" val data WidgetMarginStartPropertyInfo instance AttrInfo WidgetMarginStartPropertyInfo where type AttrAllowedOps WidgetMarginStartPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetMarginStartPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WidgetMarginStartPropertyInfo = WidgetK type AttrGetType WidgetMarginStartPropertyInfo = Int32 type AttrLabel WidgetMarginStartPropertyInfo = "Widget::margin-start" attrGet _ = getWidgetMarginStart attrSet _ = setWidgetMarginStart attrConstruct _ = constructWidgetMarginStart -- VVV Prop "margin-top" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWidgetMarginTop :: (MonadIO m, WidgetK o) => o -> m Int32 getWidgetMarginTop obj = liftIO $ getObjectPropertyCInt obj "margin-top" setWidgetMarginTop :: (MonadIO m, WidgetK o) => o -> Int32 -> m () setWidgetMarginTop obj val = liftIO $ setObjectPropertyCInt obj "margin-top" val constructWidgetMarginTop :: Int32 -> IO ([Char], GValue) constructWidgetMarginTop val = constructObjectPropertyCInt "margin-top" val data WidgetMarginTopPropertyInfo instance AttrInfo WidgetMarginTopPropertyInfo where type AttrAllowedOps WidgetMarginTopPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetMarginTopPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WidgetMarginTopPropertyInfo = WidgetK type AttrGetType WidgetMarginTopPropertyInfo = Int32 type AttrLabel WidgetMarginTopPropertyInfo = "Widget::margin-top" attrGet _ = getWidgetMarginTop attrSet _ = setWidgetMarginTop attrConstruct _ = constructWidgetMarginTop -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getWidgetName :: (MonadIO m, WidgetK o) => o -> m T.Text getWidgetName obj = liftIO $ getObjectPropertyString obj "name" setWidgetName :: (MonadIO m, WidgetK o) => o -> T.Text -> m () setWidgetName obj val = liftIO $ setObjectPropertyString obj "name" val constructWidgetName :: T.Text -> IO ([Char], GValue) constructWidgetName val = constructObjectPropertyString "name" val data WidgetNamePropertyInfo instance AttrInfo WidgetNamePropertyInfo where type AttrAllowedOps WidgetNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint WidgetNamePropertyInfo = WidgetK type AttrGetType WidgetNamePropertyInfo = T.Text type AttrLabel WidgetNamePropertyInfo = "Widget::name" attrGet _ = getWidgetName attrSet _ = setWidgetName attrConstruct _ = constructWidgetName -- VVV Prop "no-show-all" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetNoShowAll :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetNoShowAll obj = liftIO $ getObjectPropertyBool obj "no-show-all" setWidgetNoShowAll :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetNoShowAll obj val = liftIO $ setObjectPropertyBool obj "no-show-all" val constructWidgetNoShowAll :: Bool -> IO ([Char], GValue) constructWidgetNoShowAll val = constructObjectPropertyBool "no-show-all" val data WidgetNoShowAllPropertyInfo instance AttrInfo WidgetNoShowAllPropertyInfo where type AttrAllowedOps WidgetNoShowAllPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetNoShowAllPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetNoShowAllPropertyInfo = WidgetK type AttrGetType WidgetNoShowAllPropertyInfo = Bool type AttrLabel WidgetNoShowAllPropertyInfo = "Widget::no-show-all" attrGet _ = getWidgetNoShowAll attrSet _ = setWidgetNoShowAll attrConstruct _ = constructWidgetNoShowAll -- VVV Prop "opacity" -- Type: TBasicType TDouble -- Flags: [PropertyReadable,PropertyWritable] getWidgetOpacity :: (MonadIO m, WidgetK o) => o -> m Double getWidgetOpacity obj = liftIO $ getObjectPropertyDouble obj "opacity" setWidgetOpacity :: (MonadIO m, WidgetK o) => o -> Double -> m () setWidgetOpacity obj val = liftIO $ setObjectPropertyDouble obj "opacity" val constructWidgetOpacity :: Double -> IO ([Char], GValue) constructWidgetOpacity val = constructObjectPropertyDouble "opacity" val data WidgetOpacityPropertyInfo instance AttrInfo WidgetOpacityPropertyInfo where type AttrAllowedOps WidgetOpacityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetOpacityPropertyInfo = (~) Double type AttrBaseTypeConstraint WidgetOpacityPropertyInfo = WidgetK type AttrGetType WidgetOpacityPropertyInfo = Double type AttrLabel WidgetOpacityPropertyInfo = "Widget::opacity" attrGet _ = getWidgetOpacity attrSet _ = setWidgetOpacity attrConstruct _ = constructWidgetOpacity -- VVV Prop "parent" -- Type: TInterface "Gtk" "Container" -- Flags: [PropertyReadable,PropertyWritable] getWidgetParent :: (MonadIO m, WidgetK o) => o -> m Container getWidgetParent obj = liftIO $ getObjectPropertyObject obj "parent" Container setWidgetParent :: (MonadIO m, WidgetK o, ContainerK a) => o -> a -> m () setWidgetParent obj val = liftIO $ setObjectPropertyObject obj "parent" val constructWidgetParent :: (ContainerK a) => a -> IO ([Char], GValue) constructWidgetParent val = constructObjectPropertyObject "parent" val data WidgetParentPropertyInfo instance AttrInfo WidgetParentPropertyInfo where type AttrAllowedOps WidgetParentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetParentPropertyInfo = ContainerK type AttrBaseTypeConstraint WidgetParentPropertyInfo = WidgetK type AttrGetType WidgetParentPropertyInfo = Container type AttrLabel WidgetParentPropertyInfo = "Widget::parent" attrGet _ = getWidgetParent attrSet _ = setWidgetParent attrConstruct _ = constructWidgetParent -- VVV Prop "receives-default" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetReceivesDefault :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetReceivesDefault obj = liftIO $ getObjectPropertyBool obj "receives-default" setWidgetReceivesDefault :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetReceivesDefault obj val = liftIO $ setObjectPropertyBool obj "receives-default" val constructWidgetReceivesDefault :: Bool -> IO ([Char], GValue) constructWidgetReceivesDefault val = constructObjectPropertyBool "receives-default" val data WidgetReceivesDefaultPropertyInfo instance AttrInfo WidgetReceivesDefaultPropertyInfo where type AttrAllowedOps WidgetReceivesDefaultPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetReceivesDefaultPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetReceivesDefaultPropertyInfo = WidgetK type AttrGetType WidgetReceivesDefaultPropertyInfo = Bool type AttrLabel WidgetReceivesDefaultPropertyInfo = "Widget::receives-default" attrGet _ = getWidgetReceivesDefault attrSet _ = setWidgetReceivesDefault attrConstruct _ = constructWidgetReceivesDefault -- VVV Prop "scale-factor" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable] getWidgetScaleFactor :: (MonadIO m, WidgetK o) => o -> m Int32 getWidgetScaleFactor obj = liftIO $ getObjectPropertyCInt obj "scale-factor" data WidgetScaleFactorPropertyInfo instance AttrInfo WidgetScaleFactorPropertyInfo where type AttrAllowedOps WidgetScaleFactorPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint WidgetScaleFactorPropertyInfo = (~) () type AttrBaseTypeConstraint WidgetScaleFactorPropertyInfo = WidgetK type AttrGetType WidgetScaleFactorPropertyInfo = Int32 type AttrLabel WidgetScaleFactorPropertyInfo = "Widget::scale-factor" attrGet _ = getWidgetScaleFactor attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "sensitive" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetSensitive :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetSensitive obj = liftIO $ getObjectPropertyBool obj "sensitive" setWidgetSensitive :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetSensitive obj val = liftIO $ setObjectPropertyBool obj "sensitive" val constructWidgetSensitive :: Bool -> IO ([Char], GValue) constructWidgetSensitive val = constructObjectPropertyBool "sensitive" val data WidgetSensitivePropertyInfo instance AttrInfo WidgetSensitivePropertyInfo where type AttrAllowedOps WidgetSensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetSensitivePropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetSensitivePropertyInfo = WidgetK type AttrGetType WidgetSensitivePropertyInfo = Bool type AttrLabel WidgetSensitivePropertyInfo = "Widget::sensitive" attrGet _ = getWidgetSensitive attrSet _ = setWidgetSensitive attrConstruct _ = constructWidgetSensitive -- VVV Prop "style" -- Type: TInterface "Gtk" "Style" -- Flags: [PropertyReadable,PropertyWritable] getWidgetStyle :: (MonadIO m, WidgetK o) => o -> m Style getWidgetStyle obj = liftIO $ getObjectPropertyObject obj "style" Style setWidgetStyle :: (MonadIO m, WidgetK o, StyleK a) => o -> a -> m () setWidgetStyle obj val = liftIO $ setObjectPropertyObject obj "style" val constructWidgetStyle :: (StyleK a) => a -> IO ([Char], GValue) constructWidgetStyle val = constructObjectPropertyObject "style" val data WidgetStylePropertyInfo instance AttrInfo WidgetStylePropertyInfo where type AttrAllowedOps WidgetStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetStylePropertyInfo = StyleK type AttrBaseTypeConstraint WidgetStylePropertyInfo = WidgetK type AttrGetType WidgetStylePropertyInfo = Style type AttrLabel WidgetStylePropertyInfo = "Widget::style" attrGet _ = getWidgetStyle attrSet _ = setWidgetStyle attrConstruct _ = constructWidgetStyle -- VVV Prop "tooltip-markup" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getWidgetTooltipMarkup :: (MonadIO m, WidgetK o) => o -> m T.Text getWidgetTooltipMarkup obj = liftIO $ getObjectPropertyString obj "tooltip-markup" setWidgetTooltipMarkup :: (MonadIO m, WidgetK o) => o -> T.Text -> m () setWidgetTooltipMarkup obj val = liftIO $ setObjectPropertyString obj "tooltip-markup" val constructWidgetTooltipMarkup :: T.Text -> IO ([Char], GValue) constructWidgetTooltipMarkup val = constructObjectPropertyString "tooltip-markup" val data WidgetTooltipMarkupPropertyInfo instance AttrInfo WidgetTooltipMarkupPropertyInfo where type AttrAllowedOps WidgetTooltipMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetTooltipMarkupPropertyInfo = (~) T.Text type AttrBaseTypeConstraint WidgetTooltipMarkupPropertyInfo = WidgetK type AttrGetType WidgetTooltipMarkupPropertyInfo = T.Text type AttrLabel WidgetTooltipMarkupPropertyInfo = "Widget::tooltip-markup" attrGet _ = getWidgetTooltipMarkup attrSet _ = setWidgetTooltipMarkup attrConstruct _ = constructWidgetTooltipMarkup -- VVV Prop "tooltip-text" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getWidgetTooltipText :: (MonadIO m, WidgetK o) => o -> m T.Text getWidgetTooltipText obj = liftIO $ getObjectPropertyString obj "tooltip-text" setWidgetTooltipText :: (MonadIO m, WidgetK o) => o -> T.Text -> m () setWidgetTooltipText obj val = liftIO $ setObjectPropertyString obj "tooltip-text" val constructWidgetTooltipText :: T.Text -> IO ([Char], GValue) constructWidgetTooltipText val = constructObjectPropertyString "tooltip-text" val data WidgetTooltipTextPropertyInfo instance AttrInfo WidgetTooltipTextPropertyInfo where type AttrAllowedOps WidgetTooltipTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetTooltipTextPropertyInfo = (~) T.Text type AttrBaseTypeConstraint WidgetTooltipTextPropertyInfo = WidgetK type AttrGetType WidgetTooltipTextPropertyInfo = T.Text type AttrLabel WidgetTooltipTextPropertyInfo = "Widget::tooltip-text" attrGet _ = getWidgetTooltipText attrSet _ = setWidgetTooltipText attrConstruct _ = constructWidgetTooltipText -- VVV Prop "valign" -- Type: TInterface "Gtk" "Align" -- Flags: [PropertyReadable,PropertyWritable] getWidgetValign :: (MonadIO m, WidgetK o) => o -> m Align getWidgetValign obj = liftIO $ getObjectPropertyEnum obj "valign" setWidgetValign :: (MonadIO m, WidgetK o) => o -> Align -> m () setWidgetValign obj val = liftIO $ setObjectPropertyEnum obj "valign" val constructWidgetValign :: Align -> IO ([Char], GValue) constructWidgetValign val = constructObjectPropertyEnum "valign" val data WidgetValignPropertyInfo instance AttrInfo WidgetValignPropertyInfo where type AttrAllowedOps WidgetValignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetValignPropertyInfo = (~) Align type AttrBaseTypeConstraint WidgetValignPropertyInfo = WidgetK type AttrGetType WidgetValignPropertyInfo = Align type AttrLabel WidgetValignPropertyInfo = "Widget::valign" attrGet _ = getWidgetValign attrSet _ = setWidgetValign attrConstruct _ = constructWidgetValign -- VVV Prop "vexpand" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetVexpand :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetVexpand obj = liftIO $ getObjectPropertyBool obj "vexpand" setWidgetVexpand :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetVexpand obj val = liftIO $ setObjectPropertyBool obj "vexpand" val constructWidgetVexpand :: Bool -> IO ([Char], GValue) constructWidgetVexpand val = constructObjectPropertyBool "vexpand" val data WidgetVexpandPropertyInfo instance AttrInfo WidgetVexpandPropertyInfo where type AttrAllowedOps WidgetVexpandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetVexpandPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetVexpandPropertyInfo = WidgetK type AttrGetType WidgetVexpandPropertyInfo = Bool type AttrLabel WidgetVexpandPropertyInfo = "Widget::vexpand" attrGet _ = getWidgetVexpand attrSet _ = setWidgetVexpand attrConstruct _ = constructWidgetVexpand -- VVV Prop "vexpand-set" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetVexpandSet :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetVexpandSet obj = liftIO $ getObjectPropertyBool obj "vexpand-set" setWidgetVexpandSet :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetVexpandSet obj val = liftIO $ setObjectPropertyBool obj "vexpand-set" val constructWidgetVexpandSet :: Bool -> IO ([Char], GValue) constructWidgetVexpandSet val = constructObjectPropertyBool "vexpand-set" val data WidgetVexpandSetPropertyInfo instance AttrInfo WidgetVexpandSetPropertyInfo where type AttrAllowedOps WidgetVexpandSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetVexpandSetPropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetVexpandSetPropertyInfo = WidgetK type AttrGetType WidgetVexpandSetPropertyInfo = Bool type AttrLabel WidgetVexpandSetPropertyInfo = "Widget::vexpand-set" attrGet _ = getWidgetVexpandSet attrSet _ = setWidgetVexpandSet attrConstruct _ = constructWidgetVexpandSet -- VVV Prop "visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWidgetVisible :: (MonadIO m, WidgetK o) => o -> m Bool getWidgetVisible obj = liftIO $ getObjectPropertyBool obj "visible" setWidgetVisible :: (MonadIO m, WidgetK o) => o -> Bool -> m () setWidgetVisible obj val = liftIO $ setObjectPropertyBool obj "visible" val constructWidgetVisible :: Bool -> IO ([Char], GValue) constructWidgetVisible val = constructObjectPropertyBool "visible" val data WidgetVisiblePropertyInfo instance AttrInfo WidgetVisiblePropertyInfo where type AttrAllowedOps WidgetVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetVisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint WidgetVisiblePropertyInfo = WidgetK type AttrGetType WidgetVisiblePropertyInfo = Bool type AttrLabel WidgetVisiblePropertyInfo = "Widget::visible" attrGet _ = getWidgetVisible attrSet _ = setWidgetVisible attrConstruct _ = constructWidgetVisible -- VVV Prop "width-request" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWidgetWidthRequest :: (MonadIO m, WidgetK o) => o -> m Int32 getWidgetWidthRequest obj = liftIO $ getObjectPropertyCInt obj "width-request" setWidgetWidthRequest :: (MonadIO m, WidgetK o) => o -> Int32 -> m () setWidgetWidthRequest obj val = liftIO $ setObjectPropertyCInt obj "width-request" val constructWidgetWidthRequest :: Int32 -> IO ([Char], GValue) constructWidgetWidthRequest val = constructObjectPropertyCInt "width-request" val data WidgetWidthRequestPropertyInfo instance AttrInfo WidgetWidthRequestPropertyInfo where type AttrAllowedOps WidgetWidthRequestPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WidgetWidthRequestPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WidgetWidthRequestPropertyInfo = WidgetK type AttrGetType WidgetWidthRequestPropertyInfo = Int32 type AttrLabel WidgetWidthRequestPropertyInfo = "Widget::width-request" attrGet _ = getWidgetWidthRequest attrSet _ = setWidgetWidthRequest attrConstruct _ = constructWidgetWidthRequest -- VVV Prop "window" -- Type: TInterface "Gdk" "Window" -- Flags: [PropertyReadable] getWidgetWindow :: (MonadIO m, WidgetK o) => o -> m Gdk.Window getWidgetWindow obj = liftIO $ getObjectPropertyObject obj "window" Gdk.Window data WidgetWindowPropertyInfo instance AttrInfo WidgetWindowPropertyInfo where type AttrAllowedOps WidgetWindowPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint WidgetWindowPropertyInfo = (~) () type AttrBaseTypeConstraint WidgetWindowPropertyInfo = WidgetK type AttrGetType WidgetWindowPropertyInfo = Gdk.Window type AttrLabel WidgetWindowPropertyInfo = "Widget::window" attrGet _ = getWidgetWindow attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList Widget = '[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] type instance AttributeList WidgetAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] -- VVV Prop "accept-focus" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowAcceptFocus :: (MonadIO m, WindowK o) => o -> m Bool getWindowAcceptFocus obj = liftIO $ getObjectPropertyBool obj "accept-focus" setWindowAcceptFocus :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowAcceptFocus obj val = liftIO $ setObjectPropertyBool obj "accept-focus" val constructWindowAcceptFocus :: Bool -> IO ([Char], GValue) constructWindowAcceptFocus val = constructObjectPropertyBool "accept-focus" val data WindowAcceptFocusPropertyInfo instance AttrInfo WindowAcceptFocusPropertyInfo where type AttrAllowedOps WindowAcceptFocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowAcceptFocusPropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowAcceptFocusPropertyInfo = WindowK type AttrGetType WindowAcceptFocusPropertyInfo = Bool type AttrLabel WindowAcceptFocusPropertyInfo = "Window::accept-focus" attrGet _ = getWindowAcceptFocus attrSet _ = setWindowAcceptFocus attrConstruct _ = constructWindowAcceptFocus -- VVV Prop "application" -- Type: TInterface "Gtk" "Application" -- Flags: [PropertyReadable,PropertyWritable] getWindowApplication :: (MonadIO m, WindowK o) => o -> m Application getWindowApplication obj = liftIO $ getObjectPropertyObject obj "application" Application setWindowApplication :: (MonadIO m, WindowK o, ApplicationK a) => o -> a -> m () setWindowApplication obj val = liftIO $ setObjectPropertyObject obj "application" val constructWindowApplication :: (ApplicationK a) => a -> IO ([Char], GValue) constructWindowApplication val = constructObjectPropertyObject "application" val data WindowApplicationPropertyInfo instance AttrInfo WindowApplicationPropertyInfo where type AttrAllowedOps WindowApplicationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowApplicationPropertyInfo = ApplicationK type AttrBaseTypeConstraint WindowApplicationPropertyInfo = WindowK type AttrGetType WindowApplicationPropertyInfo = Application type AttrLabel WindowApplicationPropertyInfo = "Window::application" attrGet _ = getWindowApplication attrSet _ = setWindowApplication attrConstruct _ = constructWindowApplication -- VVV Prop "attached-to" -- Type: TInterface "Gtk" "Widget" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getWindowAttachedTo :: (MonadIO m, WindowK o) => o -> m Widget getWindowAttachedTo obj = liftIO $ getObjectPropertyObject obj "attached-to" Widget setWindowAttachedTo :: (MonadIO m, WindowK o, WidgetK a) => o -> a -> m () setWindowAttachedTo obj val = liftIO $ setObjectPropertyObject obj "attached-to" val constructWindowAttachedTo :: (WidgetK a) => a -> IO ([Char], GValue) constructWindowAttachedTo val = constructObjectPropertyObject "attached-to" val data WindowAttachedToPropertyInfo instance AttrInfo WindowAttachedToPropertyInfo where type AttrAllowedOps WindowAttachedToPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowAttachedToPropertyInfo = WidgetK type AttrBaseTypeConstraint WindowAttachedToPropertyInfo = WindowK type AttrGetType WindowAttachedToPropertyInfo = Widget type AttrLabel WindowAttachedToPropertyInfo = "Window::attached-to" attrGet _ = getWindowAttachedTo attrSet _ = setWindowAttachedTo attrConstruct _ = constructWindowAttachedTo -- VVV Prop "decorated" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowDecorated :: (MonadIO m, WindowK o) => o -> m Bool getWindowDecorated obj = liftIO $ getObjectPropertyBool obj "decorated" setWindowDecorated :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowDecorated obj val = liftIO $ setObjectPropertyBool obj "decorated" val constructWindowDecorated :: Bool -> IO ([Char], GValue) constructWindowDecorated val = constructObjectPropertyBool "decorated" val data WindowDecoratedPropertyInfo instance AttrInfo WindowDecoratedPropertyInfo where type AttrAllowedOps WindowDecoratedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowDecoratedPropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowDecoratedPropertyInfo = WindowK type AttrGetType WindowDecoratedPropertyInfo = Bool type AttrLabel WindowDecoratedPropertyInfo = "Window::decorated" attrGet _ = getWindowDecorated attrSet _ = setWindowDecorated attrConstruct _ = constructWindowDecorated -- VVV Prop "default-height" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWindowDefaultHeight :: (MonadIO m, WindowK o) => o -> m Int32 getWindowDefaultHeight obj = liftIO $ getObjectPropertyCInt obj "default-height" setWindowDefaultHeight :: (MonadIO m, WindowK o) => o -> Int32 -> m () setWindowDefaultHeight obj val = liftIO $ setObjectPropertyCInt obj "default-height" val constructWindowDefaultHeight :: Int32 -> IO ([Char], GValue) constructWindowDefaultHeight val = constructObjectPropertyCInt "default-height" val data WindowDefaultHeightPropertyInfo instance AttrInfo WindowDefaultHeightPropertyInfo where type AttrAllowedOps WindowDefaultHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowDefaultHeightPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WindowDefaultHeightPropertyInfo = WindowK type AttrGetType WindowDefaultHeightPropertyInfo = Int32 type AttrLabel WindowDefaultHeightPropertyInfo = "Window::default-height" attrGet _ = getWindowDefaultHeight attrSet _ = setWindowDefaultHeight attrConstruct _ = constructWindowDefaultHeight -- VVV Prop "default-width" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getWindowDefaultWidth :: (MonadIO m, WindowK o) => o -> m Int32 getWindowDefaultWidth obj = liftIO $ getObjectPropertyCInt obj "default-width" setWindowDefaultWidth :: (MonadIO m, WindowK o) => o -> Int32 -> m () setWindowDefaultWidth obj val = liftIO $ setObjectPropertyCInt obj "default-width" val constructWindowDefaultWidth :: Int32 -> IO ([Char], GValue) constructWindowDefaultWidth val = constructObjectPropertyCInt "default-width" val data WindowDefaultWidthPropertyInfo instance AttrInfo WindowDefaultWidthPropertyInfo where type AttrAllowedOps WindowDefaultWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowDefaultWidthPropertyInfo = (~) Int32 type AttrBaseTypeConstraint WindowDefaultWidthPropertyInfo = WindowK type AttrGetType WindowDefaultWidthPropertyInfo = Int32 type AttrLabel WindowDefaultWidthPropertyInfo = "Window::default-width" attrGet _ = getWindowDefaultWidth attrSet _ = setWindowDefaultWidth attrConstruct _ = constructWindowDefaultWidth -- VVV Prop "deletable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowDeletable :: (MonadIO m, WindowK o) => o -> m Bool getWindowDeletable obj = liftIO $ getObjectPropertyBool obj "deletable" setWindowDeletable :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowDeletable obj val = liftIO $ setObjectPropertyBool obj "deletable" val constructWindowDeletable :: Bool -> IO ([Char], GValue) constructWindowDeletable val = constructObjectPropertyBool "deletable" val data WindowDeletablePropertyInfo instance AttrInfo WindowDeletablePropertyInfo where type AttrAllowedOps WindowDeletablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowDeletablePropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowDeletablePropertyInfo = WindowK type AttrGetType WindowDeletablePropertyInfo = Bool type AttrLabel WindowDeletablePropertyInfo = "Window::deletable" attrGet _ = getWindowDeletable attrSet _ = setWindowDeletable attrConstruct _ = constructWindowDeletable -- VVV Prop "destroy-with-parent" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowDestroyWithParent :: (MonadIO m, WindowK o) => o -> m Bool getWindowDestroyWithParent obj = liftIO $ getObjectPropertyBool obj "destroy-with-parent" setWindowDestroyWithParent :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowDestroyWithParent obj val = liftIO $ setObjectPropertyBool obj "destroy-with-parent" val constructWindowDestroyWithParent :: Bool -> IO ([Char], GValue) constructWindowDestroyWithParent val = constructObjectPropertyBool "destroy-with-parent" val data WindowDestroyWithParentPropertyInfo instance AttrInfo WindowDestroyWithParentPropertyInfo where type AttrAllowedOps WindowDestroyWithParentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowDestroyWithParentPropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowDestroyWithParentPropertyInfo = WindowK type AttrGetType WindowDestroyWithParentPropertyInfo = Bool type AttrLabel WindowDestroyWithParentPropertyInfo = "Window::destroy-with-parent" attrGet _ = getWindowDestroyWithParent attrSet _ = setWindowDestroyWithParent attrConstruct _ = constructWindowDestroyWithParent -- VVV Prop "focus-on-map" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowFocusOnMap :: (MonadIO m, WindowK o) => o -> m Bool getWindowFocusOnMap obj = liftIO $ getObjectPropertyBool obj "focus-on-map" setWindowFocusOnMap :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowFocusOnMap obj val = liftIO $ setObjectPropertyBool obj "focus-on-map" val constructWindowFocusOnMap :: Bool -> IO ([Char], GValue) constructWindowFocusOnMap val = constructObjectPropertyBool "focus-on-map" val data WindowFocusOnMapPropertyInfo instance AttrInfo WindowFocusOnMapPropertyInfo where type AttrAllowedOps WindowFocusOnMapPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowFocusOnMapPropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowFocusOnMapPropertyInfo = WindowK type AttrGetType WindowFocusOnMapPropertyInfo = Bool type AttrLabel WindowFocusOnMapPropertyInfo = "Window::focus-on-map" attrGet _ = getWindowFocusOnMap attrSet _ = setWindowFocusOnMap attrConstruct _ = constructWindowFocusOnMap -- VVV Prop "focus-visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowFocusVisible :: (MonadIO m, WindowK o) => o -> m Bool getWindowFocusVisible obj = liftIO $ getObjectPropertyBool obj "focus-visible" setWindowFocusVisible :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowFocusVisible obj val = liftIO $ setObjectPropertyBool obj "focus-visible" val constructWindowFocusVisible :: Bool -> IO ([Char], GValue) constructWindowFocusVisible val = constructObjectPropertyBool "focus-visible" val data WindowFocusVisiblePropertyInfo instance AttrInfo WindowFocusVisiblePropertyInfo where type AttrAllowedOps WindowFocusVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowFocusVisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowFocusVisiblePropertyInfo = WindowK type AttrGetType WindowFocusVisiblePropertyInfo = Bool type AttrLabel WindowFocusVisiblePropertyInfo = "Window::focus-visible" attrGet _ = getWindowFocusVisible attrSet _ = setWindowFocusVisible attrConstruct _ = constructWindowFocusVisible -- VVV Prop "gravity" -- Type: TInterface "Gdk" "Gravity" -- Flags: [PropertyReadable,PropertyWritable] getWindowGravity :: (MonadIO m, WindowK o) => o -> m Gdk.Gravity getWindowGravity obj = liftIO $ getObjectPropertyEnum obj "gravity" setWindowGravity :: (MonadIO m, WindowK o) => o -> Gdk.Gravity -> m () setWindowGravity obj val = liftIO $ setObjectPropertyEnum obj "gravity" val constructWindowGravity :: Gdk.Gravity -> IO ([Char], GValue) constructWindowGravity val = constructObjectPropertyEnum "gravity" val data WindowGravityPropertyInfo instance AttrInfo WindowGravityPropertyInfo where type AttrAllowedOps WindowGravityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowGravityPropertyInfo = (~) Gdk.Gravity type AttrBaseTypeConstraint WindowGravityPropertyInfo = WindowK type AttrGetType WindowGravityPropertyInfo = Gdk.Gravity type AttrLabel WindowGravityPropertyInfo = "Window::gravity" attrGet _ = getWindowGravity attrSet _ = setWindowGravity attrConstruct _ = constructWindowGravity -- VVV Prop "has-resize-grip" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowHasResizeGrip :: (MonadIO m, WindowK o) => o -> m Bool getWindowHasResizeGrip obj = liftIO $ getObjectPropertyBool obj "has-resize-grip" setWindowHasResizeGrip :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowHasResizeGrip obj val = liftIO $ setObjectPropertyBool obj "has-resize-grip" val constructWindowHasResizeGrip :: Bool -> IO ([Char], GValue) constructWindowHasResizeGrip val = constructObjectPropertyBool "has-resize-grip" val data WindowHasResizeGripPropertyInfo instance AttrInfo WindowHasResizeGripPropertyInfo where type AttrAllowedOps WindowHasResizeGripPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowHasResizeGripPropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowHasResizeGripPropertyInfo = WindowK type AttrGetType WindowHasResizeGripPropertyInfo = Bool type AttrLabel WindowHasResizeGripPropertyInfo = "Window::has-resize-grip" attrGet _ = getWindowHasResizeGrip attrSet _ = setWindowHasResizeGrip attrConstruct _ = constructWindowHasResizeGrip -- VVV Prop "has-toplevel-focus" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getWindowHasToplevelFocus :: (MonadIO m, WindowK o) => o -> m Bool getWindowHasToplevelFocus obj = liftIO $ getObjectPropertyBool obj "has-toplevel-focus" data WindowHasToplevelFocusPropertyInfo instance AttrInfo WindowHasToplevelFocusPropertyInfo where type AttrAllowedOps WindowHasToplevelFocusPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint WindowHasToplevelFocusPropertyInfo = (~) () type AttrBaseTypeConstraint WindowHasToplevelFocusPropertyInfo = WindowK type AttrGetType WindowHasToplevelFocusPropertyInfo = Bool type AttrLabel WindowHasToplevelFocusPropertyInfo = "Window::has-toplevel-focus" attrGet _ = getWindowHasToplevelFocus attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "hide-titlebar-when-maximized" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowHideTitlebarWhenMaximized :: (MonadIO m, WindowK o) => o -> m Bool getWindowHideTitlebarWhenMaximized obj = liftIO $ getObjectPropertyBool obj "hide-titlebar-when-maximized" setWindowHideTitlebarWhenMaximized :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowHideTitlebarWhenMaximized obj val = liftIO $ setObjectPropertyBool obj "hide-titlebar-when-maximized" val constructWindowHideTitlebarWhenMaximized :: Bool -> IO ([Char], GValue) constructWindowHideTitlebarWhenMaximized val = constructObjectPropertyBool "hide-titlebar-when-maximized" val data WindowHideTitlebarWhenMaximizedPropertyInfo instance AttrInfo WindowHideTitlebarWhenMaximizedPropertyInfo where type AttrAllowedOps WindowHideTitlebarWhenMaximizedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowHideTitlebarWhenMaximizedPropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowHideTitlebarWhenMaximizedPropertyInfo = WindowK type AttrGetType WindowHideTitlebarWhenMaximizedPropertyInfo = Bool type AttrLabel WindowHideTitlebarWhenMaximizedPropertyInfo = "Window::hide-titlebar-when-maximized" attrGet _ = getWindowHideTitlebarWhenMaximized attrSet _ = setWindowHideTitlebarWhenMaximized attrConstruct _ = constructWindowHideTitlebarWhenMaximized -- VVV Prop "icon" -- Type: TInterface "GdkPixbuf" "Pixbuf" -- Flags: [PropertyReadable,PropertyWritable] getWindowIcon :: (MonadIO m, WindowK o) => o -> m GdkPixbuf.Pixbuf getWindowIcon obj = liftIO $ getObjectPropertyObject obj "icon" GdkPixbuf.Pixbuf setWindowIcon :: (MonadIO m, WindowK o, GdkPixbuf.PixbufK a) => o -> a -> m () setWindowIcon obj val = liftIO $ setObjectPropertyObject obj "icon" val constructWindowIcon :: (GdkPixbuf.PixbufK a) => a -> IO ([Char], GValue) constructWindowIcon val = constructObjectPropertyObject "icon" val data WindowIconPropertyInfo instance AttrInfo WindowIconPropertyInfo where type AttrAllowedOps WindowIconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowIconPropertyInfo = GdkPixbuf.PixbufK type AttrBaseTypeConstraint WindowIconPropertyInfo = WindowK type AttrGetType WindowIconPropertyInfo = GdkPixbuf.Pixbuf type AttrLabel WindowIconPropertyInfo = "Window::icon" attrGet _ = getWindowIcon attrSet _ = setWindowIcon attrConstruct _ = constructWindowIcon -- VVV Prop "icon-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getWindowIconName :: (MonadIO m, WindowK o) => o -> m T.Text getWindowIconName obj = liftIO $ getObjectPropertyString obj "icon-name" setWindowIconName :: (MonadIO m, WindowK o) => o -> T.Text -> m () setWindowIconName obj val = liftIO $ setObjectPropertyString obj "icon-name" val constructWindowIconName :: T.Text -> IO ([Char], GValue) constructWindowIconName val = constructObjectPropertyString "icon-name" val data WindowIconNamePropertyInfo instance AttrInfo WindowIconNamePropertyInfo where type AttrAllowedOps WindowIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint WindowIconNamePropertyInfo = WindowK type AttrGetType WindowIconNamePropertyInfo = T.Text type AttrLabel WindowIconNamePropertyInfo = "Window::icon-name" attrGet _ = getWindowIconName attrSet _ = setWindowIconName attrConstruct _ = constructWindowIconName -- VVV Prop "is-active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getWindowIsActive :: (MonadIO m, WindowK o) => o -> m Bool getWindowIsActive obj = liftIO $ getObjectPropertyBool obj "is-active" data WindowIsActivePropertyInfo instance AttrInfo WindowIsActivePropertyInfo where type AttrAllowedOps WindowIsActivePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint WindowIsActivePropertyInfo = (~) () type AttrBaseTypeConstraint WindowIsActivePropertyInfo = WindowK type AttrGetType WindowIsActivePropertyInfo = Bool type AttrLabel WindowIsActivePropertyInfo = "Window::is-active" attrGet _ = getWindowIsActive attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-maximized" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getWindowIsMaximized :: (MonadIO m, WindowK o) => o -> m Bool getWindowIsMaximized obj = liftIO $ getObjectPropertyBool obj "is-maximized" data WindowIsMaximizedPropertyInfo instance AttrInfo WindowIsMaximizedPropertyInfo where type AttrAllowedOps WindowIsMaximizedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint WindowIsMaximizedPropertyInfo = (~) () type AttrBaseTypeConstraint WindowIsMaximizedPropertyInfo = WindowK type AttrGetType WindowIsMaximizedPropertyInfo = Bool type AttrLabel WindowIsMaximizedPropertyInfo = "Window::is-maximized" attrGet _ = getWindowIsMaximized attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "mnemonics-visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowMnemonicsVisible :: (MonadIO m, WindowK o) => o -> m Bool getWindowMnemonicsVisible obj = liftIO $ getObjectPropertyBool obj "mnemonics-visible" setWindowMnemonicsVisible :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowMnemonicsVisible obj val = liftIO $ setObjectPropertyBool obj "mnemonics-visible" val constructWindowMnemonicsVisible :: Bool -> IO ([Char], GValue) constructWindowMnemonicsVisible val = constructObjectPropertyBool "mnemonics-visible" val data WindowMnemonicsVisiblePropertyInfo instance AttrInfo WindowMnemonicsVisiblePropertyInfo where type AttrAllowedOps WindowMnemonicsVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowMnemonicsVisiblePropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowMnemonicsVisiblePropertyInfo = WindowK type AttrGetType WindowMnemonicsVisiblePropertyInfo = Bool type AttrLabel WindowMnemonicsVisiblePropertyInfo = "Window::mnemonics-visible" attrGet _ = getWindowMnemonicsVisible attrSet _ = setWindowMnemonicsVisible attrConstruct _ = constructWindowMnemonicsVisible -- VVV Prop "modal" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowModal :: (MonadIO m, WindowK o) => o -> m Bool getWindowModal obj = liftIO $ getObjectPropertyBool obj "modal" setWindowModal :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowModal obj val = liftIO $ setObjectPropertyBool obj "modal" val constructWindowModal :: Bool -> IO ([Char], GValue) constructWindowModal val = constructObjectPropertyBool "modal" val data WindowModalPropertyInfo instance AttrInfo WindowModalPropertyInfo where type AttrAllowedOps WindowModalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowModalPropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowModalPropertyInfo = WindowK type AttrGetType WindowModalPropertyInfo = Bool type AttrLabel WindowModalPropertyInfo = "Window::modal" attrGet _ = getWindowModal attrSet _ = setWindowModal attrConstruct _ = constructWindowModal -- VVV Prop "resizable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowResizable :: (MonadIO m, WindowK o) => o -> m Bool getWindowResizable obj = liftIO $ getObjectPropertyBool obj "resizable" setWindowResizable :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowResizable obj val = liftIO $ setObjectPropertyBool obj "resizable" val constructWindowResizable :: Bool -> IO ([Char], GValue) constructWindowResizable val = constructObjectPropertyBool "resizable" val data WindowResizablePropertyInfo instance AttrInfo WindowResizablePropertyInfo where type AttrAllowedOps WindowResizablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowResizablePropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowResizablePropertyInfo = WindowK type AttrGetType WindowResizablePropertyInfo = Bool type AttrLabel WindowResizablePropertyInfo = "Window::resizable" attrGet _ = getWindowResizable attrSet _ = setWindowResizable attrConstruct _ = constructWindowResizable -- VVV Prop "resize-grip-visible" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getWindowResizeGripVisible :: (MonadIO m, WindowK o) => o -> m Bool getWindowResizeGripVisible obj = liftIO $ getObjectPropertyBool obj "resize-grip-visible" data WindowResizeGripVisiblePropertyInfo instance AttrInfo WindowResizeGripVisiblePropertyInfo where type AttrAllowedOps WindowResizeGripVisiblePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint WindowResizeGripVisiblePropertyInfo = (~) () type AttrBaseTypeConstraint WindowResizeGripVisiblePropertyInfo = WindowK type AttrGetType WindowResizeGripVisiblePropertyInfo = Bool type AttrLabel WindowResizeGripVisiblePropertyInfo = "Window::resize-grip-visible" attrGet _ = getWindowResizeGripVisible attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "role" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getWindowRole :: (MonadIO m, WindowK o) => o -> m T.Text getWindowRole obj = liftIO $ getObjectPropertyString obj "role" setWindowRole :: (MonadIO m, WindowK o) => o -> T.Text -> m () setWindowRole obj val = liftIO $ setObjectPropertyString obj "role" val constructWindowRole :: T.Text -> IO ([Char], GValue) constructWindowRole val = constructObjectPropertyString "role" val data WindowRolePropertyInfo instance AttrInfo WindowRolePropertyInfo where type AttrAllowedOps WindowRolePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowRolePropertyInfo = (~) T.Text type AttrBaseTypeConstraint WindowRolePropertyInfo = WindowK type AttrGetType WindowRolePropertyInfo = T.Text type AttrLabel WindowRolePropertyInfo = "Window::role" attrGet _ = getWindowRole attrSet _ = setWindowRole attrConstruct _ = constructWindowRole -- VVV Prop "screen" -- Type: TInterface "Gdk" "Screen" -- Flags: [PropertyReadable,PropertyWritable] getWindowScreen :: (MonadIO m, WindowK o) => o -> m Gdk.Screen getWindowScreen obj = liftIO $ getObjectPropertyObject obj "screen" Gdk.Screen setWindowScreen :: (MonadIO m, WindowK o, Gdk.ScreenK a) => o -> a -> m () setWindowScreen obj val = liftIO $ setObjectPropertyObject obj "screen" val constructWindowScreen :: (Gdk.ScreenK a) => a -> IO ([Char], GValue) constructWindowScreen val = constructObjectPropertyObject "screen" val data WindowScreenPropertyInfo instance AttrInfo WindowScreenPropertyInfo where type AttrAllowedOps WindowScreenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowScreenPropertyInfo = Gdk.ScreenK type AttrBaseTypeConstraint WindowScreenPropertyInfo = WindowK type AttrGetType WindowScreenPropertyInfo = Gdk.Screen type AttrLabel WindowScreenPropertyInfo = "Window::screen" attrGet _ = getWindowScreen attrSet _ = setWindowScreen attrConstruct _ = constructWindowScreen -- VVV Prop "skip-pager-hint" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowSkipPagerHint :: (MonadIO m, WindowK o) => o -> m Bool getWindowSkipPagerHint obj = liftIO $ getObjectPropertyBool obj "skip-pager-hint" setWindowSkipPagerHint :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowSkipPagerHint obj val = liftIO $ setObjectPropertyBool obj "skip-pager-hint" val constructWindowSkipPagerHint :: Bool -> IO ([Char], GValue) constructWindowSkipPagerHint val = constructObjectPropertyBool "skip-pager-hint" val data WindowSkipPagerHintPropertyInfo instance AttrInfo WindowSkipPagerHintPropertyInfo where type AttrAllowedOps WindowSkipPagerHintPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowSkipPagerHintPropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowSkipPagerHintPropertyInfo = WindowK type AttrGetType WindowSkipPagerHintPropertyInfo = Bool type AttrLabel WindowSkipPagerHintPropertyInfo = "Window::skip-pager-hint" attrGet _ = getWindowSkipPagerHint attrSet _ = setWindowSkipPagerHint attrConstruct _ = constructWindowSkipPagerHint -- VVV Prop "skip-taskbar-hint" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowSkipTaskbarHint :: (MonadIO m, WindowK o) => o -> m Bool getWindowSkipTaskbarHint obj = liftIO $ getObjectPropertyBool obj "skip-taskbar-hint" setWindowSkipTaskbarHint :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowSkipTaskbarHint obj val = liftIO $ setObjectPropertyBool obj "skip-taskbar-hint" val constructWindowSkipTaskbarHint :: Bool -> IO ([Char], GValue) constructWindowSkipTaskbarHint val = constructObjectPropertyBool "skip-taskbar-hint" val data WindowSkipTaskbarHintPropertyInfo instance AttrInfo WindowSkipTaskbarHintPropertyInfo where type AttrAllowedOps WindowSkipTaskbarHintPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowSkipTaskbarHintPropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowSkipTaskbarHintPropertyInfo = WindowK type AttrGetType WindowSkipTaskbarHintPropertyInfo = Bool type AttrLabel WindowSkipTaskbarHintPropertyInfo = "Window::skip-taskbar-hint" attrGet _ = getWindowSkipTaskbarHint attrSet _ = setWindowSkipTaskbarHint attrConstruct _ = constructWindowSkipTaskbarHint -- VVV Prop "startup-id" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setWindowStartupId :: (MonadIO m, WindowK o) => o -> T.Text -> m () setWindowStartupId obj val = liftIO $ setObjectPropertyString obj "startup-id" val constructWindowStartupId :: T.Text -> IO ([Char], GValue) constructWindowStartupId val = constructObjectPropertyString "startup-id" val data WindowStartupIdPropertyInfo instance AttrInfo WindowStartupIdPropertyInfo where type AttrAllowedOps WindowStartupIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint WindowStartupIdPropertyInfo = (~) T.Text type AttrBaseTypeConstraint WindowStartupIdPropertyInfo = WindowK type AttrGetType WindowStartupIdPropertyInfo = () type AttrLabel WindowStartupIdPropertyInfo = "Window::startup-id" attrGet _ = undefined attrSet _ = setWindowStartupId attrConstruct _ = constructWindowStartupId -- VVV Prop "title" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getWindowTitle :: (MonadIO m, WindowK o) => o -> m T.Text getWindowTitle obj = liftIO $ getObjectPropertyString obj "title" setWindowTitle :: (MonadIO m, WindowK o) => o -> T.Text -> m () setWindowTitle obj val = liftIO $ setObjectPropertyString obj "title" val constructWindowTitle :: T.Text -> IO ([Char], GValue) constructWindowTitle val = constructObjectPropertyString "title" val data WindowTitlePropertyInfo instance AttrInfo WindowTitlePropertyInfo where type AttrAllowedOps WindowTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowTitlePropertyInfo = (~) T.Text type AttrBaseTypeConstraint WindowTitlePropertyInfo = WindowK type AttrGetType WindowTitlePropertyInfo = T.Text type AttrLabel WindowTitlePropertyInfo = "Window::title" attrGet _ = getWindowTitle attrSet _ = setWindowTitle attrConstruct _ = constructWindowTitle -- VVV Prop "transient-for" -- Type: TInterface "Gtk" "Window" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getWindowTransientFor :: (MonadIO m, WindowK o) => o -> m Window getWindowTransientFor obj = liftIO $ getObjectPropertyObject obj "transient-for" Window setWindowTransientFor :: (MonadIO m, WindowK o, WindowK a) => o -> a -> m () setWindowTransientFor obj val = liftIO $ setObjectPropertyObject obj "transient-for" val constructWindowTransientFor :: (WindowK a) => a -> IO ([Char], GValue) constructWindowTransientFor val = constructObjectPropertyObject "transient-for" val data WindowTransientForPropertyInfo instance AttrInfo WindowTransientForPropertyInfo where type AttrAllowedOps WindowTransientForPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowTransientForPropertyInfo = WindowK type AttrBaseTypeConstraint WindowTransientForPropertyInfo = WindowK type AttrGetType WindowTransientForPropertyInfo = Window type AttrLabel WindowTransientForPropertyInfo = "Window::transient-for" attrGet _ = getWindowTransientFor attrSet _ = setWindowTransientFor attrConstruct _ = constructWindowTransientFor -- VVV Prop "type" -- Type: TInterface "Gtk" "WindowType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getWindowType :: (MonadIO m, WindowK o) => o -> m WindowType getWindowType obj = liftIO $ getObjectPropertyEnum obj "type" constructWindowType :: WindowType -> IO ([Char], GValue) constructWindowType val = constructObjectPropertyEnum "type" val data WindowTypePropertyInfo instance AttrInfo WindowTypePropertyInfo where type AttrAllowedOps WindowTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowTypePropertyInfo = (~) WindowType type AttrBaseTypeConstraint WindowTypePropertyInfo = WindowK type AttrGetType WindowTypePropertyInfo = WindowType type AttrLabel WindowTypePropertyInfo = "Window::type" attrGet _ = getWindowType attrSet _ = undefined attrConstruct _ = constructWindowType -- VVV Prop "type-hint" -- Type: TInterface "Gdk" "WindowTypeHint" -- Flags: [PropertyReadable,PropertyWritable] getWindowTypeHint :: (MonadIO m, WindowK o) => o -> m Gdk.WindowTypeHint getWindowTypeHint obj = liftIO $ getObjectPropertyEnum obj "type-hint" setWindowTypeHint :: (MonadIO m, WindowK o) => o -> Gdk.WindowTypeHint -> m () setWindowTypeHint obj val = liftIO $ setObjectPropertyEnum obj "type-hint" val constructWindowTypeHint :: Gdk.WindowTypeHint -> IO ([Char], GValue) constructWindowTypeHint val = constructObjectPropertyEnum "type-hint" val data WindowTypeHintPropertyInfo instance AttrInfo WindowTypeHintPropertyInfo where type AttrAllowedOps WindowTypeHintPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowTypeHintPropertyInfo = (~) Gdk.WindowTypeHint type AttrBaseTypeConstraint WindowTypeHintPropertyInfo = WindowK type AttrGetType WindowTypeHintPropertyInfo = Gdk.WindowTypeHint type AttrLabel WindowTypeHintPropertyInfo = "Window::type-hint" attrGet _ = getWindowTypeHint attrSet _ = setWindowTypeHint attrConstruct _ = constructWindowTypeHint -- VVV Prop "urgency-hint" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getWindowUrgencyHint :: (MonadIO m, WindowK o) => o -> m Bool getWindowUrgencyHint obj = liftIO $ getObjectPropertyBool obj "urgency-hint" setWindowUrgencyHint :: (MonadIO m, WindowK o) => o -> Bool -> m () setWindowUrgencyHint obj val = liftIO $ setObjectPropertyBool obj "urgency-hint" val constructWindowUrgencyHint :: Bool -> IO ([Char], GValue) constructWindowUrgencyHint val = constructObjectPropertyBool "urgency-hint" val data WindowUrgencyHintPropertyInfo instance AttrInfo WindowUrgencyHintPropertyInfo where type AttrAllowedOps WindowUrgencyHintPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowUrgencyHintPropertyInfo = (~) Bool type AttrBaseTypeConstraint WindowUrgencyHintPropertyInfo = WindowK type AttrGetType WindowUrgencyHintPropertyInfo = Bool type AttrLabel WindowUrgencyHintPropertyInfo = "Window::urgency-hint" attrGet _ = getWindowUrgencyHint attrSet _ = setWindowUrgencyHint attrConstruct _ = constructWindowUrgencyHint -- VVV Prop "window-position" -- Type: TInterface "Gtk" "WindowPosition" -- Flags: [PropertyReadable,PropertyWritable] getWindowWindowPosition :: (MonadIO m, WindowK o) => o -> m WindowPosition getWindowWindowPosition obj = liftIO $ getObjectPropertyEnum obj "window-position" setWindowWindowPosition :: (MonadIO m, WindowK o) => o -> WindowPosition -> m () setWindowWindowPosition obj val = liftIO $ setObjectPropertyEnum obj "window-position" val constructWindowWindowPosition :: WindowPosition -> IO ([Char], GValue) constructWindowWindowPosition val = constructObjectPropertyEnum "window-position" val data WindowWindowPositionPropertyInfo instance AttrInfo WindowWindowPositionPropertyInfo where type AttrAllowedOps WindowWindowPositionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WindowWindowPositionPropertyInfo = (~) WindowPosition type AttrBaseTypeConstraint WindowWindowPositionPropertyInfo = WindowK type AttrGetType WindowWindowPositionPropertyInfo = WindowPosition type AttrLabel WindowWindowPositionPropertyInfo = "Window::window-position" attrGet _ = getWindowWindowPosition attrSet _ = setWindowWindowPosition attrConstruct _ = constructWindowWindowPosition type instance AttributeList Window = '[ '("accept-focus", WindowAcceptFocusPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("application", WindowApplicationPropertyInfo), '("attached-to", WindowAttachedToPropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("decorated", WindowDecoratedPropertyInfo), '("default-height", WindowDefaultHeightPropertyInfo), '("default-width", WindowDefaultWidthPropertyInfo), '("deletable", WindowDeletablePropertyInfo), '("destroy-with-parent", WindowDestroyWithParentPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-map", WindowFocusOnMapPropertyInfo), '("focus-visible", WindowFocusVisiblePropertyInfo), '("gravity", WindowGravityPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-resize-grip", WindowHasResizeGripPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("has-toplevel-focus", WindowHasToplevelFocusPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hide-titlebar-when-maximized", WindowHideTitlebarWhenMaximizedPropertyInfo), '("icon", WindowIconPropertyInfo), '("icon-name", WindowIconNamePropertyInfo), '("is-active", WindowIsActivePropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("is-maximized", WindowIsMaximizedPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("mnemonics-visible", WindowMnemonicsVisiblePropertyInfo), '("modal", WindowModalPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resizable", WindowResizablePropertyInfo), '("resize-grip-visible", WindowResizeGripVisiblePropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("role", WindowRolePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("screen", WindowScreenPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("skip-pager-hint", WindowSkipPagerHintPropertyInfo), '("skip-taskbar-hint", WindowSkipTaskbarHintPropertyInfo), '("startup-id", WindowStartupIdPropertyInfo), '("style", WidgetStylePropertyInfo), '("title", WindowTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("transient-for", WindowTransientForPropertyInfo), '("type", WindowTypePropertyInfo), '("type-hint", WindowTypeHintPropertyInfo), '("urgency-hint", WindowUrgencyHintPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-position", WindowWindowPositionPropertyInfo)] type instance AttributeList WindowAccessible = '[ '("accessible-component-layer", AtkA.ObjectAccessibleComponentLayerPropertyInfo), '("accessible-component-mdi-zorder", AtkA.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessible-description", AtkA.ObjectAccessibleDescriptionPropertyInfo), '("accessible-hypertext-nlinks", AtkA.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessible-name", AtkA.ObjectAccessibleNamePropertyInfo), '("accessible-parent", AtkA.ObjectAccessibleParentPropertyInfo), '("accessible-role", AtkA.ObjectAccessibleRolePropertyInfo), '("accessible-table-caption", AtkA.ObjectAccessibleTableCaptionPropertyInfo), '("accessible-table-caption-object", AtkA.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessible-table-column-description", AtkA.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessible-table-column-header", AtkA.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessible-table-row-description", AtkA.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessible-table-row-header", AtkA.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessible-table-summary", AtkA.ObjectAccessibleTableSummaryPropertyInfo), '("accessible-value", AtkA.ObjectAccessibleValuePropertyInfo), '("widget", AccessibleWidgetPropertyInfo)] type instance AttributeList WindowGroup = '[ ]