{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An icon factory manages a collection of t'GI.Gtk.Structs.IconSet.IconSet'; a t'GI.Gtk.Structs.IconSet.IconSet' manages a
-- set of variants of a particular icon (i.e. a t'GI.Gtk.Structs.IconSet.IconSet' contains variants for
-- different sizes and widget states). Icons in an icon factory are named by a
-- stock ID, which is a simple string identifying the icon. Each t'GI.Gtk.Objects.Style.Style' has a
-- list of t'GI.Gtk.Objects.IconFactory.IconFactory' derived from the current theme; those icon factories
-- are consulted first when searching for an icon. If the theme doesn’t set a
-- particular icon, GTK+ looks for the icon in a list of default icon factories,
-- maintained by 'GI.Gtk.Objects.IconFactory.iconFactoryAddDefault' and
-- 'GI.Gtk.Objects.IconFactory.iconFactoryRemoveDefault'. Applications with icons should add a default
-- icon factory with their icons, which will allow themes to override the icons
-- for the application.
-- 
-- To display an icon, always use 'GI.Gtk.Objects.Style.styleLookupIconSet' on the widget that
-- will display the icon, or the convenience function
-- 'GI.Gtk.Objects.Widget.widgetRenderIcon'. These functions take the theme into account when
-- looking up the icon to use for a given stock ID.
-- 
-- # GtkIconFactory as GtkBuildable # {t'GI.Gtk.Objects.IconFactory.IconFactory'-BUILDER-UI}
-- 
-- GtkIconFactory supports a custom \<sources> element, which can contain
-- multiple \<source> elements. The following attributes are allowed:
-- 
-- * stock-id
-- 
-- 
--     The stock id of the source, a string. This attribute is
--     mandatory
-- 
-- * filename
-- 
-- 
--     The filename of the source, a string.  This attribute is
--     optional
-- 
-- * icon-name
-- 
-- 
--     The icon name for the source, a string.  This attribute is
--     optional.
-- 
-- * size
-- 
-- 
--     Size of the icon, a t'GI.Gtk.Enums.IconSize' enum value.  This attribute is
--     optional.
-- 
-- * direction
-- 
-- 
--     Direction of the source, a t'GI.Gtk.Enums.TextDirection' enum value.  This
--     attribute is optional.
-- 
-- * state
-- 
-- 
--     State of the source, a t'GI.Gtk.Enums.StateType' enum value.  This
--     attribute is optional.
-- 
-- 
-- ## A t'GI.Gtk.Objects.IconFactory.IconFactory' UI definition fragment. ##
-- 
-- >
-- ><object class="GtkIconFactory" id="iconfactory1">
-- >  <sources>
-- >    <source stock-id="apple-red" filename="apple-red.png"/>
-- >  </sources>
-- ></object>
-- ><object class="GtkWindow" id="window1">
-- >  <child>
-- >    <object class="GtkButton" id="apple_button">
-- >      <property name="label">apple-red</property>
-- >      <property name="use-stock">True</property>
-- >    </object>
-- >  </child>
-- ></object>
-- 

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

module GI.Gtk.Objects.IconFactory
    ( 

-- * Exported types
    IconFactory(..)                         ,
    IsIconFactory                           ,
    toIconFactory                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveIconFactoryMethod                ,
#endif


-- ** add #method:add#

#if defined(ENABLE_OVERLOADING)
    IconFactoryAddMethodInfo                ,
#endif
    iconFactoryAdd                          ,


-- ** addDefault #method:addDefault#

#if defined(ENABLE_OVERLOADING)
    IconFactoryAddDefaultMethodInfo         ,
#endif
    iconFactoryAddDefault                   ,


-- ** lookup #method:lookup#

#if defined(ENABLE_OVERLOADING)
    IconFactoryLookupMethodInfo             ,
#endif
    iconFactoryLookup                       ,


-- ** lookupDefault #method:lookupDefault#

    iconFactoryLookupDefault                ,


-- ** new #method:new#

    iconFactoryNew                          ,


-- ** removeDefault #method:removeDefault#

#if defined(ENABLE_OVERLOADING)
    IconFactoryRemoveDefaultMethodInfo      ,
#endif
    iconFactoryRemoveDefault                ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.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 {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Structs.IconSet as Gtk.IconSet

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

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

foreign import ccall "gtk_icon_factory_get_type"
    c_gtk_icon_factory_get_type :: IO B.Types.GType

instance B.Types.TypedObject IconFactory where
    glibType :: IO GType
glibType = IO GType
c_gtk_icon_factory_get_type

instance B.Types.GObject IconFactory

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

-- | Type class for types which can be safely cast to `IconFactory`, for instance with `toIconFactory`.
class (SP.GObject o, O.IsDescendantOf IconFactory o) => IsIconFactory o
instance (SP.GObject o, O.IsDescendantOf IconFactory o) => IsIconFactory o

instance O.HasParentTypes IconFactory
type instance O.ParentTypes IconFactory = '[GObject.Object.Object, Gtk.Buildable.Buildable]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveIconFactoryMethod (t :: Symbol) (o :: *) :: * where
    ResolveIconFactoryMethod "add" o = IconFactoryAddMethodInfo
    ResolveIconFactoryMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveIconFactoryMethod "addDefault" o = IconFactoryAddDefaultMethodInfo
    ResolveIconFactoryMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveIconFactoryMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveIconFactoryMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveIconFactoryMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveIconFactoryMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveIconFactoryMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveIconFactoryMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveIconFactoryMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveIconFactoryMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveIconFactoryMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveIconFactoryMethod "lookup" o = IconFactoryLookupMethodInfo
    ResolveIconFactoryMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveIconFactoryMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveIconFactoryMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveIconFactoryMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveIconFactoryMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveIconFactoryMethod "removeDefault" o = IconFactoryRemoveDefaultMethodInfo
    ResolveIconFactoryMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveIconFactoryMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveIconFactoryMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveIconFactoryMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveIconFactoryMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveIconFactoryMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveIconFactoryMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveIconFactoryMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveIconFactoryMethod "getName" o = Gtk.Buildable.BuildableGetNameMethodInfo
    ResolveIconFactoryMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveIconFactoryMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveIconFactoryMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveIconFactoryMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveIconFactoryMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveIconFactoryMethod "setName" o = Gtk.Buildable.BuildableSetNameMethodInfo
    ResolveIconFactoryMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveIconFactoryMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList IconFactory
type instance O.AttributeList IconFactory = IconFactoryAttributeList
type IconFactoryAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "gtk_icon_factory_new" gtk_icon_factory_new :: 
    IO (Ptr IconFactory)

{-# DEPRECATED iconFactoryNew ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
-- | Creates a new t'GI.Gtk.Objects.IconFactory.IconFactory'. An icon factory manages a collection
-- of @/GtkIconSets/@; a t'GI.Gtk.Structs.IconSet.IconSet' manages a set of variants of a
-- particular icon (i.e. a t'GI.Gtk.Structs.IconSet.IconSet' contains variants for different
-- sizes and widget states). Icons in an icon factory are named by a
-- stock ID, which is a simple string identifying the icon. Each
-- t'GI.Gtk.Objects.Style.Style' has a list of @/GtkIconFactorys/@ derived from the current
-- theme; those icon factories are consulted first when searching for
-- an icon. If the theme doesn’t set a particular icon, GTK+ looks for
-- the icon in a list of default icon factories, maintained by
-- 'GI.Gtk.Objects.IconFactory.iconFactoryAddDefault' and
-- 'GI.Gtk.Objects.IconFactory.iconFactoryRemoveDefault'. Applications with icons should
-- add a default icon factory with their icons, which will allow
-- themes to override the icons for the application.
iconFactoryNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m IconFactory
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.IconFactory.IconFactory'
iconFactoryNew :: m IconFactory
iconFactoryNew  = IO IconFactory -> m IconFactory
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconFactory -> m IconFactory)
-> IO IconFactory -> m IconFactory
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconFactory
result <- IO (Ptr IconFactory)
gtk_icon_factory_new
    Text -> Ptr IconFactory -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconFactoryNew" Ptr IconFactory
result
    IconFactory
result' <- ((ManagedPtr IconFactory -> IconFactory)
-> Ptr IconFactory -> IO IconFactory
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr IconFactory -> IconFactory
IconFactory) Ptr IconFactory
result
    IconFactory -> IO IconFactory
forall (m :: * -> *) a. Monad m => a -> m a
return IconFactory
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method IconFactory::add
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "factory"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconFactory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkIconFactory" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stock_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "icon name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_set"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "icon set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_icon_factory_add" gtk_icon_factory_add :: 
    Ptr IconFactory ->                      -- factory : TInterface (Name {namespace = "Gtk", name = "IconFactory"})
    CString ->                              -- stock_id : TBasicType TUTF8
    Ptr Gtk.IconSet.IconSet ->              -- icon_set : TInterface (Name {namespace = "Gtk", name = "IconSet"})
    IO ()

{-# DEPRECATED iconFactoryAdd ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
-- | Adds the given /@iconSet@/ to the icon factory, under the name
-- /@stockId@/.  /@stockId@/ should be namespaced for your application,
-- e.g. “myapp-whatever-icon”.  Normally applications create a
-- t'GI.Gtk.Objects.IconFactory.IconFactory', then add it to the list of default factories with
-- 'GI.Gtk.Objects.IconFactory.iconFactoryAddDefault'. Then they pass the /@stockId@/ to
-- widgets such as t'GI.Gtk.Objects.Image.Image' to display the icon. Themes can provide
-- an icon with the same name (such as \"myapp-whatever-icon\") to
-- override your application’s default icons. If an icon already
-- existed in /@factory@/ for /@stockId@/, it is unreferenced and replaced
-- with the new /@iconSet@/.
iconFactoryAdd ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconFactory a) =>
    a
    -- ^ /@factory@/: a t'GI.Gtk.Objects.IconFactory.IconFactory'
    -> T.Text
    -- ^ /@stockId@/: icon name
    -> Gtk.IconSet.IconSet
    -- ^ /@iconSet@/: icon set
    -> m ()
iconFactoryAdd :: a -> Text -> IconSet -> m ()
iconFactoryAdd a
factory Text
stockId IconSet
iconSet = 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 IconFactory
factory' <- a -> IO (Ptr IconFactory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
factory
    CString
stockId' <- Text -> IO CString
textToCString Text
stockId
    Ptr IconSet
iconSet' <- IconSet -> IO (Ptr IconSet)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSet
iconSet
    Ptr IconFactory -> CString -> Ptr IconSet -> IO ()
gtk_icon_factory_add Ptr IconFactory
factory' CString
stockId' Ptr IconSet
iconSet'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
factory
    IconSet -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSet
iconSet
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stockId'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IconFactoryAddMethodInfo
instance (signature ~ (T.Text -> Gtk.IconSet.IconSet -> m ()), MonadIO m, IsIconFactory a) => O.MethodInfo IconFactoryAddMethodInfo a signature where
    overloadedMethod = iconFactoryAdd

#endif

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

foreign import ccall "gtk_icon_factory_add_default" gtk_icon_factory_add_default :: 
    Ptr IconFactory ->                      -- factory : TInterface (Name {namespace = "Gtk", name = "IconFactory"})
    IO ()

{-# DEPRECATED iconFactoryAddDefault ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
-- | Adds an icon factory to the list of icon factories searched by
-- 'GI.Gtk.Objects.Style.styleLookupIconSet'. This means that, for example,
-- 'GI.Gtk.Objects.Image.imageNewFromStock' will be able to find icons in /@factory@/.
-- There will normally be an icon factory added for each library or
-- application that comes with icons. The default icon factories
-- can be overridden by themes.
iconFactoryAddDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconFactory a) =>
    a
    -- ^ /@factory@/: a t'GI.Gtk.Objects.IconFactory.IconFactory'
    -> m ()
iconFactoryAddDefault :: a -> m ()
iconFactoryAddDefault a
factory = 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 IconFactory
factory' <- a -> IO (Ptr IconFactory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
factory
    Ptr IconFactory -> IO ()
gtk_icon_factory_add_default Ptr IconFactory
factory'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
factory
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IconFactoryAddDefaultMethodInfo
instance (signature ~ (m ()), MonadIO m, IsIconFactory a) => O.MethodInfo IconFactoryAddDefaultMethodInfo a signature where
    overloadedMethod = iconFactoryAddDefault

#endif

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

foreign import ccall "gtk_icon_factory_lookup" gtk_icon_factory_lookup :: 
    Ptr IconFactory ->                      -- factory : TInterface (Name {namespace = "Gtk", name = "IconFactory"})
    CString ->                              -- stock_id : TBasicType TUTF8
    IO (Ptr Gtk.IconSet.IconSet)

{-# DEPRECATED iconFactoryLookup ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
-- | Looks up /@stockId@/ in the icon factory, returning an icon set
-- if found, otherwise 'P.Nothing'. For display to the user, you should
-- use 'GI.Gtk.Objects.Style.styleLookupIconSet' on the t'GI.Gtk.Objects.Style.Style' for the
-- widget that will display the icon, instead of using this
-- function directly, so that themes are taken into account.
iconFactoryLookup ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconFactory a) =>
    a
    -- ^ /@factory@/: a t'GI.Gtk.Objects.IconFactory.IconFactory'
    -> T.Text
    -- ^ /@stockId@/: an icon name
    -> m Gtk.IconSet.IconSet
    -- ^ __Returns:__ icon set of /@stockId@/.
iconFactoryLookup :: a -> Text -> m IconSet
iconFactoryLookup a
factory Text
stockId = IO IconSet -> m IconSet
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconSet -> m IconSet) -> IO IconSet -> m IconSet
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconFactory
factory' <- a -> IO (Ptr IconFactory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
factory
    CString
stockId' <- Text -> IO CString
textToCString Text
stockId
    Ptr IconSet
result <- Ptr IconFactory -> CString -> IO (Ptr IconSet)
gtk_icon_factory_lookup Ptr IconFactory
factory' CString
stockId'
    Text -> Ptr IconSet -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconFactoryLookup" Ptr IconSet
result
    IconSet
result' <- ((ManagedPtr IconSet -> IconSet) -> Ptr IconSet -> IO IconSet
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr IconSet -> IconSet
Gtk.IconSet.IconSet) Ptr IconSet
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
factory
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stockId'
    IconSet -> IO IconSet
forall (m :: * -> *) a. Monad m => a -> m a
return IconSet
result'

#if defined(ENABLE_OVERLOADING)
data IconFactoryLookupMethodInfo
instance (signature ~ (T.Text -> m Gtk.IconSet.IconSet), MonadIO m, IsIconFactory a) => O.MethodInfo IconFactoryLookupMethodInfo a signature where
    overloadedMethod = iconFactoryLookup

#endif

-- method IconFactory::remove_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "factory"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconFactory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GtkIconFactory previously added with gtk_icon_factory_add_default()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_icon_factory_remove_default" gtk_icon_factory_remove_default :: 
    Ptr IconFactory ->                      -- factory : TInterface (Name {namespace = "Gtk", name = "IconFactory"})
    IO ()

{-# DEPRECATED iconFactoryRemoveDefault ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
-- | Removes an icon factory from the list of default icon
-- factories. Not normally used; you might use it for a library that
-- can be unloaded or shut down.
iconFactoryRemoveDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconFactory a) =>
    a
    -- ^ /@factory@/: a t'GI.Gtk.Objects.IconFactory.IconFactory' previously added with 'GI.Gtk.Objects.IconFactory.iconFactoryAddDefault'
    -> m ()
iconFactoryRemoveDefault :: a -> m ()
iconFactoryRemoveDefault a
factory = 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 IconFactory
factory' <- a -> IO (Ptr IconFactory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
factory
    Ptr IconFactory -> IO ()
gtk_icon_factory_remove_default Ptr IconFactory
factory'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
factory
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IconFactoryRemoveDefaultMethodInfo
instance (signature ~ (m ()), MonadIO m, IsIconFactory a) => O.MethodInfo IconFactoryRemoveDefaultMethodInfo a signature where
    overloadedMethod = iconFactoryRemoveDefault

#endif

-- method IconFactory::lookup_default
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "stock_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an icon name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "IconSet" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_icon_factory_lookup_default" gtk_icon_factory_lookup_default :: 
    CString ->                              -- stock_id : TBasicType TUTF8
    IO (Ptr Gtk.IconSet.IconSet)

{-# DEPRECATED iconFactoryLookupDefault ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
-- | Looks for an icon in the list of default icon factories.  For
-- display to the user, you should use 'GI.Gtk.Objects.Style.styleLookupIconSet' on
-- the t'GI.Gtk.Objects.Style.Style' for the widget that will display the icon, instead of
-- using this function directly, so that themes are taken into
-- account.
iconFactoryLookupDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@stockId@/: an icon name
    -> m Gtk.IconSet.IconSet
    -- ^ __Returns:__ a t'GI.Gtk.Structs.IconSet.IconSet', or 'P.Nothing'
iconFactoryLookupDefault :: Text -> m IconSet
iconFactoryLookupDefault Text
stockId = IO IconSet -> m IconSet
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconSet -> m IconSet) -> IO IconSet -> m IconSet
forall a b. (a -> b) -> a -> b
$ do
    CString
stockId' <- Text -> IO CString
textToCString Text
stockId
    Ptr IconSet
result <- CString -> IO (Ptr IconSet)
gtk_icon_factory_lookup_default CString
stockId'
    Text -> Ptr IconSet -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconFactoryLookupDefault" Ptr IconSet
result
    IconSet
result' <- ((ManagedPtr IconSet -> IconSet) -> Ptr IconSet -> IO IconSet
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr IconSet -> IconSet
Gtk.IconSet.IconSet) Ptr IconSet
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stockId'
    IconSet -> IO IconSet
forall (m :: * -> *) a. Monad m => a -> m a
return IconSet
result'

#if defined(ENABLE_OVERLOADING)
#endif