{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GtkNumerableIcon is a subclass of t'GI.Gio.Objects.EmblemedIcon.EmblemedIcon' that can
-- show a number or short string as an emblem. The number can
-- be overlayed on top of another emblem, if desired.
-- 
-- It supports theming by taking font and color information
-- from a provided t'GI.Gtk.Objects.StyleContext.StyleContext'; see
-- 'GI.Gtk.Objects.NumerableIcon.numerableIconSetStyleContext'.
-- 
-- Typical numerable icons:
-- <<https://developer.gnome.org/gtk3/stable/numerableicon.png>>
-- <<https://developer.gnome.org/gtk3/stable/numerableicon2.png>>

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

module GI.Gtk.Objects.NumerableIcon
    ( 

-- * Exported types
    NumerableIcon(..)                       ,
    IsNumerableIcon                         ,
    toNumerableIcon                         ,
    noNumerableIcon                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveNumerableIconMethod              ,
#endif


-- ** getBackgroundGicon #method:getBackgroundGicon#

#if defined(ENABLE_OVERLOADING)
    NumerableIconGetBackgroundGiconMethodInfo,
#endif
    numerableIconGetBackgroundGicon         ,


-- ** getBackgroundIconName #method:getBackgroundIconName#

#if defined(ENABLE_OVERLOADING)
    NumerableIconGetBackgroundIconNameMethodInfo,
#endif
    numerableIconGetBackgroundIconName      ,


-- ** getCount #method:getCount#

#if defined(ENABLE_OVERLOADING)
    NumerableIconGetCountMethodInfo         ,
#endif
    numerableIconGetCount                   ,


-- ** getLabel #method:getLabel#

#if defined(ENABLE_OVERLOADING)
    NumerableIconGetLabelMethodInfo         ,
#endif
    numerableIconGetLabel                   ,


-- ** getStyleContext #method:getStyleContext#

#if defined(ENABLE_OVERLOADING)
    NumerableIconGetStyleContextMethodInfo  ,
#endif
    numerableIconGetStyleContext            ,


-- ** new #method:new#

    numerableIconNew                        ,


-- ** newWithStyleContext #method:newWithStyleContext#

    numerableIconNewWithStyleContext        ,


-- ** setBackgroundGicon #method:setBackgroundGicon#

#if defined(ENABLE_OVERLOADING)
    NumerableIconSetBackgroundGiconMethodInfo,
#endif
    numerableIconSetBackgroundGicon         ,


-- ** setBackgroundIconName #method:setBackgroundIconName#

#if defined(ENABLE_OVERLOADING)
    NumerableIconSetBackgroundIconNameMethodInfo,
#endif
    numerableIconSetBackgroundIconName      ,


-- ** setCount #method:setCount#

#if defined(ENABLE_OVERLOADING)
    NumerableIconSetCountMethodInfo         ,
#endif
    numerableIconSetCount                   ,


-- ** setLabel #method:setLabel#

#if defined(ENABLE_OVERLOADING)
    NumerableIconSetLabelMethodInfo         ,
#endif
    numerableIconSetLabel                   ,


-- ** setStyleContext #method:setStyleContext#

#if defined(ENABLE_OVERLOADING)
    NumerableIconSetStyleContextMethodInfo  ,
#endif
    numerableIconSetStyleContext            ,




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

#if defined(ENABLE_OVERLOADING)
    NumerableIconBackgroundIconPropertyInfo ,
#endif
    clearNumerableIconBackgroundIcon        ,
    constructNumerableIconBackgroundIcon    ,
    getNumerableIconBackgroundIcon          ,
#if defined(ENABLE_OVERLOADING)
    numerableIconBackgroundIcon             ,
#endif
    setNumerableIconBackgroundIcon          ,


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

#if defined(ENABLE_OVERLOADING)
    NumerableIconBackgroundIconNamePropertyInfo,
#endif
    clearNumerableIconBackgroundIconName    ,
    constructNumerableIconBackgroundIconName,
    getNumerableIconBackgroundIconName      ,
#if defined(ENABLE_OVERLOADING)
    numerableIconBackgroundIconName         ,
#endif
    setNumerableIconBackgroundIconName      ,


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

#if defined(ENABLE_OVERLOADING)
    NumerableIconCountPropertyInfo          ,
#endif
    constructNumerableIconCount             ,
    getNumerableIconCount                   ,
#if defined(ENABLE_OVERLOADING)
    numerableIconCount                      ,
#endif
    setNumerableIconCount                   ,


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

#if defined(ENABLE_OVERLOADING)
    NumerableIconLabelPropertyInfo          ,
#endif
    clearNumerableIconLabel                 ,
    constructNumerableIconLabel             ,
    getNumerableIconLabel                   ,
#if defined(ENABLE_OVERLOADING)
    numerableIconLabel                      ,
#endif
    setNumerableIconLabel                   ,


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

#if defined(ENABLE_OVERLOADING)
    NumerableIconStyleContextPropertyInfo   ,
#endif
    constructNumerableIconStyleContext      ,
    getNumerableIconStyleContext            ,
#if defined(ENABLE_OVERLOADING)
    numerableIconStyleContext               ,
#endif
    setNumerableIconStyleContext            ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Objects.EmblemedIcon as Gio.EmblemedIcon
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext

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

instance GObject NumerableIcon where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_numerable_icon_get_type
    

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

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

instance O.HasParentTypes NumerableIcon
type instance O.ParentTypes NumerableIcon = '[Gio.EmblemedIcon.EmblemedIcon, GObject.Object.Object, Gio.Icon.Icon]

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

-- | A convenience alias for `Nothing` :: `Maybe` `NumerableIcon`.
noNumerableIcon :: Maybe NumerableIcon
noNumerableIcon :: Maybe NumerableIcon
noNumerableIcon = Maybe NumerableIcon
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveNumerableIconMethod (t :: Symbol) (o :: *) :: * where
    ResolveNumerableIconMethod "addEmblem" o = Gio.EmblemedIcon.EmblemedIconAddEmblemMethodInfo
    ResolveNumerableIconMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveNumerableIconMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveNumerableIconMethod "clearEmblems" o = Gio.EmblemedIcon.EmblemedIconClearEmblemsMethodInfo
    ResolveNumerableIconMethod "equal" o = Gio.Icon.IconEqualMethodInfo
    ResolveNumerableIconMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveNumerableIconMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveNumerableIconMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveNumerableIconMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveNumerableIconMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveNumerableIconMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveNumerableIconMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveNumerableIconMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveNumerableIconMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveNumerableIconMethod "serialize" o = Gio.Icon.IconSerializeMethodInfo
    ResolveNumerableIconMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveNumerableIconMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveNumerableIconMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveNumerableIconMethod "toString" o = Gio.Icon.IconToStringMethodInfo
    ResolveNumerableIconMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveNumerableIconMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveNumerableIconMethod "getBackgroundGicon" o = NumerableIconGetBackgroundGiconMethodInfo
    ResolveNumerableIconMethod "getBackgroundIconName" o = NumerableIconGetBackgroundIconNameMethodInfo
    ResolveNumerableIconMethod "getCount" o = NumerableIconGetCountMethodInfo
    ResolveNumerableIconMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveNumerableIconMethod "getEmblems" o = Gio.EmblemedIcon.EmblemedIconGetEmblemsMethodInfo
    ResolveNumerableIconMethod "getIcon" o = Gio.EmblemedIcon.EmblemedIconGetIconMethodInfo
    ResolveNumerableIconMethod "getLabel" o = NumerableIconGetLabelMethodInfo
    ResolveNumerableIconMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveNumerableIconMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveNumerableIconMethod "getStyleContext" o = NumerableIconGetStyleContextMethodInfo
    ResolveNumerableIconMethod "setBackgroundGicon" o = NumerableIconSetBackgroundGiconMethodInfo
    ResolveNumerableIconMethod "setBackgroundIconName" o = NumerableIconSetBackgroundIconNameMethodInfo
    ResolveNumerableIconMethod "setCount" o = NumerableIconSetCountMethodInfo
    ResolveNumerableIconMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveNumerableIconMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveNumerableIconMethod "setLabel" o = NumerableIconSetLabelMethodInfo
    ResolveNumerableIconMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveNumerableIconMethod "setStyleContext" o = NumerableIconSetStyleContextMethodInfo
    ResolveNumerableIconMethod l o = O.MethodResolutionFailed l o

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

#endif

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

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

-- | Set the value of the “@background-icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' numerableIcon [ #backgroundIcon 'Data.GI.Base.Attributes.:=' value ]
-- @
setNumerableIconBackgroundIcon :: (MonadIO m, IsNumerableIcon o, Gio.Icon.IsIcon a) => o -> a -> m ()
setNumerableIconBackgroundIcon :: o -> a -> m ()
setNumerableIconBackgroundIcon obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "background-icon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@background-icon@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNumerableIconBackgroundIcon :: (IsNumerableIcon o, Gio.Icon.IsIcon a) => a -> IO (GValueConstruct o)
constructNumerableIconBackgroundIcon :: a -> IO (GValueConstruct o)
constructNumerableIconBackgroundIcon val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "background-icon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Set the value of the “@background-icon@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #backgroundIcon
-- @
clearNumerableIconBackgroundIcon :: (MonadIO m, IsNumerableIcon o) => o -> m ()
clearNumerableIconBackgroundIcon :: o -> m ()
clearNumerableIconBackgroundIcon obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Icon -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "background-icon" (Maybe Icon
forall a. Maybe a
Nothing :: Maybe Gio.Icon.Icon)

#if defined(ENABLE_OVERLOADING)
data NumerableIconBackgroundIconPropertyInfo
instance AttrInfo NumerableIconBackgroundIconPropertyInfo where
    type AttrAllowedOps NumerableIconBackgroundIconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NumerableIconBackgroundIconPropertyInfo = IsNumerableIcon
    type AttrSetTypeConstraint NumerableIconBackgroundIconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferTypeConstraint NumerableIconBackgroundIconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferType NumerableIconBackgroundIconPropertyInfo = Gio.Icon.Icon
    type AttrGetType NumerableIconBackgroundIconPropertyInfo = (Maybe Gio.Icon.Icon)
    type AttrLabel NumerableIconBackgroundIconPropertyInfo = "background-icon"
    type AttrOrigin NumerableIconBackgroundIconPropertyInfo = NumerableIcon
    attrGet = getNumerableIconBackgroundIcon
    attrSet = setNumerableIconBackgroundIcon
    attrTransfer _ v = do
        unsafeCastTo Gio.Icon.Icon v
    attrConstruct = constructNumerableIconBackgroundIcon
    attrClear = clearNumerableIconBackgroundIcon
#endif

-- VVV Prop "background-icon-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data NumerableIconBackgroundIconNamePropertyInfo
instance AttrInfo NumerableIconBackgroundIconNamePropertyInfo where
    type AttrAllowedOps NumerableIconBackgroundIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NumerableIconBackgroundIconNamePropertyInfo = IsNumerableIcon
    type AttrSetTypeConstraint NumerableIconBackgroundIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NumerableIconBackgroundIconNamePropertyInfo = (~) T.Text
    type AttrTransferType NumerableIconBackgroundIconNamePropertyInfo = T.Text
    type AttrGetType NumerableIconBackgroundIconNamePropertyInfo = (Maybe T.Text)
    type AttrLabel NumerableIconBackgroundIconNamePropertyInfo = "background-icon-name"
    type AttrOrigin NumerableIconBackgroundIconNamePropertyInfo = NumerableIcon
    attrGet = getNumerableIconBackgroundIconName
    attrSet = setNumerableIconBackgroundIconName
    attrTransfer _ v = do
        return v
    attrConstruct = constructNumerableIconBackgroundIconName
    attrClear = clearNumerableIconBackgroundIconName
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data NumerableIconCountPropertyInfo
instance AttrInfo NumerableIconCountPropertyInfo where
    type AttrAllowedOps NumerableIconCountPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NumerableIconCountPropertyInfo = IsNumerableIcon
    type AttrSetTypeConstraint NumerableIconCountPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint NumerableIconCountPropertyInfo = (~) Int32
    type AttrTransferType NumerableIconCountPropertyInfo = Int32
    type AttrGetType NumerableIconCountPropertyInfo = Int32
    type AttrLabel NumerableIconCountPropertyInfo = "count"
    type AttrOrigin NumerableIconCountPropertyInfo = NumerableIcon
    attrGet = getNumerableIconCount
    attrSet = setNumerableIconCount
    attrTransfer _ v = do
        return v
    attrConstruct = constructNumerableIconCount
    attrClear = undefined
#endif

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data NumerableIconLabelPropertyInfo
instance AttrInfo NumerableIconLabelPropertyInfo where
    type AttrAllowedOps NumerableIconLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NumerableIconLabelPropertyInfo = IsNumerableIcon
    type AttrSetTypeConstraint NumerableIconLabelPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NumerableIconLabelPropertyInfo = (~) T.Text
    type AttrTransferType NumerableIconLabelPropertyInfo = T.Text
    type AttrGetType NumerableIconLabelPropertyInfo = (Maybe T.Text)
    type AttrLabel NumerableIconLabelPropertyInfo = "label"
    type AttrOrigin NumerableIconLabelPropertyInfo = NumerableIcon
    attrGet = getNumerableIconLabel
    attrSet = setNumerableIconLabel
    attrTransfer _ v = do
        return v
    attrConstruct = constructNumerableIconLabel
    attrClear = clearNumerableIconLabel
#endif

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

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

-- | Set the value of the “@style-context@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' numerableIcon [ #styleContext 'Data.GI.Base.Attributes.:=' value ]
-- @
setNumerableIconStyleContext :: (MonadIO m, IsNumerableIcon o, Gtk.StyleContext.IsStyleContext a) => o -> a -> m ()
setNumerableIconStyleContext :: o -> a -> m ()
setNumerableIconStyleContext obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "style-context" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

#if defined(ENABLE_OVERLOADING)
data NumerableIconStyleContextPropertyInfo
instance AttrInfo NumerableIconStyleContextPropertyInfo where
    type AttrAllowedOps NumerableIconStyleContextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NumerableIconStyleContextPropertyInfo = IsNumerableIcon
    type AttrSetTypeConstraint NumerableIconStyleContextPropertyInfo = Gtk.StyleContext.IsStyleContext
    type AttrTransferTypeConstraint NumerableIconStyleContextPropertyInfo = Gtk.StyleContext.IsStyleContext
    type AttrTransferType NumerableIconStyleContextPropertyInfo = Gtk.StyleContext.StyleContext
    type AttrGetType NumerableIconStyleContextPropertyInfo = (Maybe Gtk.StyleContext.StyleContext)
    type AttrLabel NumerableIconStyleContextPropertyInfo = "style-context"
    type AttrOrigin NumerableIconStyleContextPropertyInfo = NumerableIcon
    attrGet = getNumerableIconStyleContext
    attrSet = setNumerableIconStyleContext
    attrTransfer _ v = do
        unsafeCastTo Gtk.StyleContext.StyleContext v
    attrConstruct = constructNumerableIconStyleContext
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList NumerableIcon
type instance O.AttributeList NumerableIcon = NumerableIconAttributeList
type NumerableIconAttributeList = ('[ '("backgroundIcon", NumerableIconBackgroundIconPropertyInfo), '("backgroundIconName", NumerableIconBackgroundIconNamePropertyInfo), '("count", NumerableIconCountPropertyInfo), '("gicon", Gio.EmblemedIcon.EmblemedIconGiconPropertyInfo), '("label", NumerableIconLabelPropertyInfo), '("styleContext", NumerableIconStyleContextPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
numerableIconBackgroundIcon :: AttrLabelProxy "backgroundIcon"
numerableIconBackgroundIcon = AttrLabelProxy

numerableIconBackgroundIconName :: AttrLabelProxy "backgroundIconName"
numerableIconBackgroundIconName = AttrLabelProxy

numerableIconCount :: AttrLabelProxy "count"
numerableIconCount = AttrLabelProxy

numerableIconLabel :: AttrLabelProxy "label"
numerableIconLabel = AttrLabelProxy

numerableIconStyleContext :: AttrLabelProxy "styleContext"
numerableIconStyleContext = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList NumerableIcon = NumerableIconSignalList
type NumerableIconSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_numerable_icon_get_background_gicon" gtk_numerable_icon_get_background_gicon :: 
    Ptr NumerableIcon ->                    -- self : TInterface (Name {namespace = "Gtk", name = "NumerableIcon"})
    IO (Ptr Gio.Icon.Icon)

{-# DEPRECATED numerableIconGetBackgroundGicon ["(Since version 3.14)"] #-}
-- | Returns the t'GI.Gio.Interfaces.Icon.Icon' that was set as the base background image, or
-- 'P.Nothing' if there’s none. The caller of this function does not own
-- a reference to the returned t'GI.Gio.Interfaces.Icon.Icon'.
-- 
-- /Since: 3.0/
numerableIconGetBackgroundGicon ::
    (B.CallStack.HasCallStack, MonadIO m, IsNumerableIcon a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'
    -> m (Maybe Gio.Icon.Icon)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Icon.Icon', or 'P.Nothing'
numerableIconGetBackgroundGicon :: a -> m (Maybe Icon)
numerableIconGetBackgroundGicon self :: a
self = IO (Maybe Icon) -> m (Maybe Icon)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ do
    Ptr NumerableIcon
self' <- a -> IO (Ptr NumerableIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Icon
result <- Ptr NumerableIcon -> IO (Ptr Icon)
gtk_numerable_icon_get_background_gicon Ptr NumerableIcon
self'
    Maybe Icon
maybeResult <- Ptr Icon -> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Icon
result ((Ptr Icon -> IO Icon) -> IO (Maybe Icon))
-> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Icon
result' -> do
        Icon
result'' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result'
        Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Icon -> IO (Maybe Icon)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Icon
maybeResult

#if defined(ENABLE_OVERLOADING)
data NumerableIconGetBackgroundGiconMethodInfo
instance (signature ~ (m (Maybe Gio.Icon.Icon)), MonadIO m, IsNumerableIcon a) => O.MethodInfo NumerableIconGetBackgroundGiconMethodInfo a signature where
    overloadedMethod = numerableIconGetBackgroundGicon

#endif

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

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

{-# DEPRECATED numerableIconGetBackgroundIconName ["(Since version 3.14)"] #-}
-- | Returns the icon name used as the base background image,
-- or 'P.Nothing' if there’s none.
-- 
-- /Since: 3.0/
numerableIconGetBackgroundIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsNumerableIcon a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ an icon name, or 'P.Nothing'
numerableIconGetBackgroundIconName :: a -> m (Maybe Text)
numerableIconGetBackgroundIconName self :: a
self = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr NumerableIcon
self' <- a -> IO (Ptr NumerableIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr NumerableIcon -> IO CString
gtk_numerable_icon_get_background_icon_name Ptr NumerableIcon
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

#endif

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

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

{-# DEPRECATED numerableIconGetCount ["(Since version 3.14)"] #-}
-- | Returns the value currently displayed by /@self@/.
-- 
-- /Since: 3.0/
numerableIconGetCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsNumerableIcon a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'
    -> m Int32
    -- ^ __Returns:__ the currently displayed value
numerableIconGetCount :: a -> m Int32
numerableIconGetCount self :: a
self = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr NumerableIcon
self' <- a -> IO (Ptr NumerableIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr NumerableIcon -> IO Int32
gtk_numerable_icon_get_count Ptr NumerableIcon
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data NumerableIconGetCountMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsNumerableIcon a) => O.MethodInfo NumerableIconGetCountMethodInfo a signature where
    overloadedMethod = numerableIconGetCount

#endif

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

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

{-# DEPRECATED numerableIconGetLabel ["(Since version 3.14)"] #-}
-- | Returns the currently displayed label of the icon, or 'P.Nothing'.
-- 
-- /Since: 3.0/
numerableIconGetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsNumerableIcon a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the currently displayed label
numerableIconGetLabel :: a -> m (Maybe Text)
numerableIconGetLabel self :: a
self = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr NumerableIcon
self' <- a -> IO (Ptr NumerableIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr NumerableIcon -> IO CString
gtk_numerable_icon_get_label Ptr NumerableIcon
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

#endif

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

foreign import ccall "gtk_numerable_icon_get_style_context" gtk_numerable_icon_get_style_context :: 
    Ptr NumerableIcon ->                    -- self : TInterface (Name {namespace = "Gtk", name = "NumerableIcon"})
    IO (Ptr Gtk.StyleContext.StyleContext)

{-# DEPRECATED numerableIconGetStyleContext ["(Since version 3.14)"] #-}
-- | Returns the t'GI.Gtk.Objects.StyleContext.StyleContext' used by the icon for theming,
-- or 'P.Nothing' if there’s none.
-- 
-- /Since: 3.0/
numerableIconGetStyleContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsNumerableIcon a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'
    -> m (Maybe Gtk.StyleContext.StyleContext)
    -- ^ __Returns:__ a t'GI.Gtk.Objects.StyleContext.StyleContext', or 'P.Nothing'.
    --     This object is internal to GTK+ and should not be unreffed.
    --     Use 'GI.GObject.Objects.Object.objectRef' if you want to keep it around
numerableIconGetStyleContext :: a -> m (Maybe StyleContext)
numerableIconGetStyleContext self :: a
self = IO (Maybe StyleContext) -> m (Maybe StyleContext)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe StyleContext) -> m (Maybe StyleContext))
-> IO (Maybe StyleContext) -> m (Maybe StyleContext)
forall a b. (a -> b) -> a -> b
$ do
    Ptr NumerableIcon
self' <- a -> IO (Ptr NumerableIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr StyleContext
result <- Ptr NumerableIcon -> IO (Ptr StyleContext)
gtk_numerable_icon_get_style_context Ptr NumerableIcon
self'
    Maybe StyleContext
maybeResult <- Ptr StyleContext
-> (Ptr StyleContext -> IO StyleContext) -> IO (Maybe StyleContext)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr StyleContext
result ((Ptr StyleContext -> IO StyleContext) -> IO (Maybe StyleContext))
-> (Ptr StyleContext -> IO StyleContext) -> IO (Maybe StyleContext)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr StyleContext
result' -> do
        StyleContext
result'' <- ((ManagedPtr StyleContext -> StyleContext)
-> Ptr StyleContext -> IO StyleContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr StyleContext -> StyleContext
Gtk.StyleContext.StyleContext) Ptr StyleContext
result'
        StyleContext -> IO StyleContext
forall (m :: * -> *) a. Monad m => a -> m a
return StyleContext
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe StyleContext -> IO (Maybe StyleContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StyleContext
maybeResult

#if defined(ENABLE_OVERLOADING)
data NumerableIconGetStyleContextMethodInfo
instance (signature ~ (m (Maybe Gtk.StyleContext.StyleContext)), MonadIO m, IsNumerableIcon a) => O.MethodInfo NumerableIconGetStyleContextMethodInfo a signature where
    overloadedMethod = numerableIconGetStyleContext

#endif

-- method NumerableIcon::set_background_gicon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "NumerableIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkNumerableIcon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIcon, or %NULL" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_numerable_icon_set_background_gicon" gtk_numerable_icon_set_background_gicon :: 
    Ptr NumerableIcon ->                    -- self : TInterface (Name {namespace = "Gtk", name = "NumerableIcon"})
    Ptr Gio.Icon.Icon ->                    -- icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    IO ()

{-# DEPRECATED numerableIconSetBackgroundGicon ["(Since version 3.14)"] #-}
-- | Updates the icon to use /@icon@/ as the base background image.
-- If /@icon@/ is 'P.Nothing', /@self@/ will go back using style information
-- or default theming for its background image.
-- 
-- If this method is called and an icon name was already set as
-- background for the icon, /@icon@/ will be used, i.e. the last method
-- called between 'GI.Gtk.Objects.NumerableIcon.numerableIconSetBackgroundGicon' and
-- 'GI.Gtk.Objects.NumerableIcon.numerableIconSetBackgroundIconName' has always priority.
-- 
-- /Since: 3.0/
numerableIconSetBackgroundGicon ::
    (B.CallStack.HasCallStack, MonadIO m, IsNumerableIcon a, Gio.Icon.IsIcon b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'
    -> Maybe (b)
    -- ^ /@icon@/: a t'GI.Gio.Interfaces.Icon.Icon', or 'P.Nothing'
    -> m ()
numerableIconSetBackgroundGicon :: a -> Maybe b -> m ()
numerableIconSetBackgroundGicon self :: a
self icon :: Maybe b
icon = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr NumerableIcon
self' <- a -> IO (Ptr NumerableIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Icon
maybeIcon <- case Maybe b
icon of
        Nothing -> Ptr Icon -> IO (Ptr Icon)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
forall a. Ptr a
nullPtr
        Just jIcon :: b
jIcon -> do
            Ptr Icon
jIcon' <- b -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jIcon
            Ptr Icon -> IO (Ptr Icon)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
jIcon'
    Ptr NumerableIcon -> Ptr Icon -> IO ()
gtk_numerable_icon_set_background_gicon Ptr NumerableIcon
self' Ptr Icon
maybeIcon
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
icon b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NumerableIconSetBackgroundGiconMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsNumerableIcon a, Gio.Icon.IsIcon b) => O.MethodInfo NumerableIconSetBackgroundGiconMethodInfo a signature where
    overloadedMethod = numerableIconSetBackgroundGicon

#endif

-- method NumerableIcon::set_background_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "NumerableIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkNumerableIcon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an icon name, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

{-# DEPRECATED numerableIconSetBackgroundIconName ["(Since version 3.14)"] #-}
-- | Updates the icon to use the icon named /@iconName@/ from the
-- current icon theme as the base background image. If /@iconName@/
-- is 'P.Nothing', /@self@/ will go back using style information or default
-- theming for its background image.
-- 
-- If this method is called and a t'GI.Gio.Interfaces.Icon.Icon' was already set as
-- background for the icon, /@iconName@/ will be used, i.e. the
-- last method called between 'GI.Gtk.Objects.NumerableIcon.numerableIconSetBackgroundIconName'
-- and 'GI.Gtk.Objects.NumerableIcon.numerableIconSetBackgroundGicon' has always priority.
-- 
-- /Since: 3.0/
numerableIconSetBackgroundIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsNumerableIcon a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'
    -> Maybe (T.Text)
    -- ^ /@iconName@/: an icon name, or 'P.Nothing'
    -> m ()
numerableIconSetBackgroundIconName :: a -> Maybe Text -> m ()
numerableIconSetBackgroundIconName self :: a
self iconName :: Maybe Text
iconName = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr NumerableIcon
self' <- a -> IO (Ptr NumerableIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeIconName <- case Maybe Text
iconName of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jIconName :: Text
jIconName -> do
            CString
jIconName' <- Text -> IO CString
textToCString Text
jIconName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIconName'
    Ptr NumerableIcon -> CString -> IO ()
gtk_numerable_icon_set_background_icon_name Ptr NumerableIcon
self' CString
maybeIconName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIconName
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- method NumerableIcon::set_count
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "NumerableIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkNumerableIcon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a number between -99 and 99"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

{-# DEPRECATED numerableIconSetCount ["(Since version 3.14)"] #-}
-- | Sets the currently displayed value of /@self@/ to /@count@/.
-- 
-- The numeric value is always clamped to make it two digits, i.e.
-- between -99 and 99. Setting a count of zero removes the emblem.
-- If this method is called, and a label was already set on the icon,
-- it will automatically be reset to 'P.Nothing' before rendering the number,
-- i.e. the last method called between 'GI.Gtk.Objects.NumerableIcon.numerableIconSetCount'
-- and 'GI.Gtk.Objects.NumerableIcon.numerableIconSetLabel' has always priority.
-- 
-- /Since: 3.0/
numerableIconSetCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsNumerableIcon a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'
    -> Int32
    -- ^ /@count@/: a number between -99 and 99
    -> m ()
numerableIconSetCount :: a -> Int32 -> m ()
numerableIconSetCount self :: a
self count :: Int32
count = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr NumerableIcon
self' <- a -> IO (Ptr NumerableIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr NumerableIcon -> Int32 -> IO ()
gtk_numerable_icon_set_count Ptr NumerableIcon
self' Int32
count
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NumerableIconSetCountMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsNumerableIcon a) => O.MethodInfo NumerableIconSetCountMethodInfo a signature where
    overloadedMethod = numerableIconSetCount

#endif

-- method NumerableIcon::set_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "NumerableIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkNumerableIcon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a short label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

{-# DEPRECATED numerableIconSetLabel ["(Since version 3.14)"] #-}
-- | Sets the currently displayed value of /@self@/ to the string
-- in /@label@/. Setting an empty label removes the emblem.
-- 
-- Note that this is meant for displaying short labels, such as
-- roman numbers, or single letters. For roman numbers, consider
-- using the Unicode characters U+2160 - U+217F. Strings longer
-- than two characters will likely not be rendered very well.
-- 
-- If this method is called, and a number was already set on the
-- icon, it will automatically be reset to zero before rendering
-- the label, i.e. the last method called between
-- 'GI.Gtk.Objects.NumerableIcon.numerableIconSetLabel' and 'GI.Gtk.Objects.NumerableIcon.numerableIconSetCount'
-- has always priority.
-- 
-- /Since: 3.0/
numerableIconSetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsNumerableIcon a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'
    -> Maybe (T.Text)
    -- ^ /@label@/: a short label, or 'P.Nothing'
    -> m ()
numerableIconSetLabel :: a -> Maybe Text -> m ()
numerableIconSetLabel self :: a
self label :: Maybe Text
label = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr NumerableIcon
self' <- a -> IO (Ptr NumerableIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeLabel <- case Maybe Text
label of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jLabel :: Text
jLabel -> do
            CString
jLabel' <- Text -> IO CString
textToCString Text
jLabel
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jLabel'
    Ptr NumerableIcon -> CString -> IO ()
gtk_numerable_icon_set_label Ptr NumerableIcon
self' CString
maybeLabel
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeLabel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

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

foreign import ccall "gtk_numerable_icon_set_style_context" gtk_numerable_icon_set_style_context :: 
    Ptr NumerableIcon ->                    -- self : TInterface (Name {namespace = "Gtk", name = "NumerableIcon"})
    Ptr Gtk.StyleContext.StyleContext ->    -- style : TInterface (Name {namespace = "Gtk", name = "StyleContext"})
    IO ()

{-# DEPRECATED numerableIconSetStyleContext ["(Since version 3.14)"] #-}
-- | Updates the icon to fetch theme information from the
-- given t'GI.Gtk.Objects.StyleContext.StyleContext'.
-- 
-- /Since: 3.0/
numerableIconSetStyleContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsNumerableIcon a, Gtk.StyleContext.IsStyleContext b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'
    -> b
    -- ^ /@style@/: a t'GI.Gtk.Objects.StyleContext.StyleContext'
    -> m ()
numerableIconSetStyleContext :: a -> b -> m ()
numerableIconSetStyleContext self :: a
self style :: b
style = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr NumerableIcon
self' <- a -> IO (Ptr NumerableIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr StyleContext
style' <- b -> IO (Ptr StyleContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
style
    Ptr NumerableIcon -> Ptr StyleContext -> IO ()
gtk_numerable_icon_set_style_context Ptr NumerableIcon
self' Ptr StyleContext
style'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
style
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NumerableIconSetStyleContextMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsNumerableIcon a, Gtk.StyleContext.IsStyleContext b) => O.MethodInfo NumerableIconSetStyleContextMethodInfo a signature where
    overloadedMethod = numerableIconSetStyleContext

#endif

-- method NumerableIcon::new
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "base_icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIcon to overlay on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Icon" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_numerable_icon_new" gtk_numerable_icon_new :: 
    Ptr Gio.Icon.Icon ->                    -- base_icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    IO (Ptr Gio.Icon.Icon)

{-# DEPRECATED numerableIconNew ["(Since version 3.14)"] #-}
-- | Creates a new unthemed t'GI.Gtk.Objects.NumerableIcon.NumerableIcon'.
-- 
-- /Since: 3.0/
numerableIconNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Icon.IsIcon a) =>
    a
    -- ^ /@baseIcon@/: a t'GI.Gio.Interfaces.Icon.Icon' to overlay on
    -> m Gio.Icon.Icon
    -- ^ __Returns:__ a new t'GI.Gio.Interfaces.Icon.Icon'
numerableIconNew :: a -> m Icon
numerableIconNew baseIcon :: a
baseIcon = IO Icon -> m Icon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Icon -> m Icon) -> IO Icon -> m Icon
forall a b. (a -> b) -> a -> b
$ do
    Ptr Icon
baseIcon' <- a -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
baseIcon
    Ptr Icon
result <- Ptr Icon -> IO (Ptr Icon)
gtk_numerable_icon_new Ptr Icon
baseIcon'
    Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "numerableIconNew" Ptr Icon
result
    Icon
result' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
baseIcon
    Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method NumerableIcon::new_with_style_context
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "base_icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIcon to overlay on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StyleContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStyleContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Icon" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_numerable_icon_new_with_style_context" gtk_numerable_icon_new_with_style_context :: 
    Ptr Gio.Icon.Icon ->                    -- base_icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    Ptr Gtk.StyleContext.StyleContext ->    -- context : TInterface (Name {namespace = "Gtk", name = "StyleContext"})
    IO (Ptr Gio.Icon.Icon)

{-# DEPRECATED numerableIconNewWithStyleContext ["(Since version 3.14)"] #-}
-- | Creates a new t'GI.Gtk.Objects.NumerableIcon.NumerableIcon' which will themed according
-- to the passed t'GI.Gtk.Objects.StyleContext.StyleContext'. This is a convenience constructor
-- that calls 'GI.Gtk.Objects.NumerableIcon.numerableIconSetStyleContext' internally.
-- 
-- /Since: 3.0/
numerableIconNewWithStyleContext ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Icon.IsIcon a, Gtk.StyleContext.IsStyleContext b) =>
    a
    -- ^ /@baseIcon@/: a t'GI.Gio.Interfaces.Icon.Icon' to overlay on
    -> b
    -- ^ /@context@/: a t'GI.Gtk.Objects.StyleContext.StyleContext'
    -> m Gio.Icon.Icon
    -- ^ __Returns:__ a new t'GI.Gio.Interfaces.Icon.Icon'
numerableIconNewWithStyleContext :: a -> b -> m Icon
numerableIconNewWithStyleContext baseIcon :: a
baseIcon context :: b
context = IO Icon -> m Icon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Icon -> m Icon) -> IO Icon -> m Icon
forall a b. (a -> b) -> a -> b
$ do
    Ptr Icon
baseIcon' <- a -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
baseIcon
    Ptr StyleContext
context' <- b -> IO (Ptr StyleContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr Icon
result <- Ptr Icon -> Ptr StyleContext -> IO (Ptr Icon)
gtk_numerable_icon_new_with_style_context Ptr Icon
baseIcon' Ptr StyleContext
context'
    Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "numerableIconNewWithStyleContext" Ptr Icon
result
    Icon
result' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
baseIcon
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'

#if defined(ENABLE_OVERLOADING)
#endif