{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Contains information found when looking up an icon in
-- an icon theme.

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

module GI.Gtk.Objects.IconInfo
    ( 

-- * Exported types
    IconInfo(..)                            ,
    IsIconInfo                              ,
    toIconInfo                              ,
    noIconInfo                              ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveIconInfoMethod                   ,
#endif


-- ** getBaseScale #method:getBaseScale#

#if defined(ENABLE_OVERLOADING)
    IconInfoGetBaseScaleMethodInfo          ,
#endif
    iconInfoGetBaseScale                    ,


-- ** getBaseSize #method:getBaseSize#

#if defined(ENABLE_OVERLOADING)
    IconInfoGetBaseSizeMethodInfo           ,
#endif
    iconInfoGetBaseSize                     ,


-- ** getFilename #method:getFilename#

#if defined(ENABLE_OVERLOADING)
    IconInfoGetFilenameMethodInfo           ,
#endif
    iconInfoGetFilename                     ,


-- ** isSymbolic #method:isSymbolic#

#if defined(ENABLE_OVERLOADING)
    IconInfoIsSymbolicMethodInfo            ,
#endif
    iconInfoIsSymbolic                      ,


-- ** loadIcon #method:loadIcon#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadIconMethodInfo              ,
#endif
    iconInfoLoadIcon                        ,


-- ** loadIconAsync #method:loadIconAsync#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadIconAsyncMethodInfo         ,
#endif
    iconInfoLoadIconAsync                   ,


-- ** loadIconFinish #method:loadIconFinish#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadIconFinishMethodInfo        ,
#endif
    iconInfoLoadIconFinish                  ,


-- ** loadSymbolic #method:loadSymbolic#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadSymbolicMethodInfo          ,
#endif
    iconInfoLoadSymbolic                    ,


-- ** loadSymbolicAsync #method:loadSymbolicAsync#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadSymbolicAsyncMethodInfo     ,
#endif
    iconInfoLoadSymbolicAsync               ,


-- ** loadSymbolicFinish #method:loadSymbolicFinish#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadSymbolicFinishMethodInfo    ,
#endif
    iconInfoLoadSymbolicFinish              ,


-- ** loadSymbolicForContext #method:loadSymbolicForContext#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadSymbolicForContextMethodInfo,
#endif
    iconInfoLoadSymbolicForContext          ,


-- ** loadSymbolicForContextAsync #method:loadSymbolicForContextAsync#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadSymbolicForContextAsyncMethodInfo,
#endif
    iconInfoLoadSymbolicForContextAsync     ,


-- ** loadSymbolicForContextFinish #method:loadSymbolicForContextFinish#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadSymbolicForContextFinishMethodInfo,
#endif
    iconInfoLoadSymbolicForContextFinish    ,


-- ** loadTexture #method:loadTexture#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadTextureMethodInfo           ,
#endif
    iconInfoLoadTexture                     ,


-- ** newForPixbuf #method:newForPixbuf#

    iconInfoNewForPixbuf                    ,




    ) 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.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gtk.Objects.IconTheme as Gtk.IconTheme
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext

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

instance GObject IconInfo where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_icon_info_get_type
    

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

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

instance O.HasParentTypes IconInfo
type instance O.ParentTypes IconInfo = '[GObject.Object.Object]

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

-- | A convenience alias for `Nothing` :: `Maybe` `IconInfo`.
noIconInfo :: Maybe IconInfo
noIconInfo :: Maybe IconInfo
noIconInfo = Maybe IconInfo
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveIconInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveIconInfoMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveIconInfoMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveIconInfoMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveIconInfoMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveIconInfoMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveIconInfoMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveIconInfoMethod "isSymbolic" o = IconInfoIsSymbolicMethodInfo
    ResolveIconInfoMethod "loadIcon" o = IconInfoLoadIconMethodInfo
    ResolveIconInfoMethod "loadIconAsync" o = IconInfoLoadIconAsyncMethodInfo
    ResolveIconInfoMethod "loadIconFinish" o = IconInfoLoadIconFinishMethodInfo
    ResolveIconInfoMethod "loadSymbolic" o = IconInfoLoadSymbolicMethodInfo
    ResolveIconInfoMethod "loadSymbolicAsync" o = IconInfoLoadSymbolicAsyncMethodInfo
    ResolveIconInfoMethod "loadSymbolicFinish" o = IconInfoLoadSymbolicFinishMethodInfo
    ResolveIconInfoMethod "loadSymbolicForContext" o = IconInfoLoadSymbolicForContextMethodInfo
    ResolveIconInfoMethod "loadSymbolicForContextAsync" o = IconInfoLoadSymbolicForContextAsyncMethodInfo
    ResolveIconInfoMethod "loadSymbolicForContextFinish" o = IconInfoLoadSymbolicForContextFinishMethodInfo
    ResolveIconInfoMethod "loadTexture" o = IconInfoLoadTextureMethodInfo
    ResolveIconInfoMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveIconInfoMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveIconInfoMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveIconInfoMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveIconInfoMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveIconInfoMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveIconInfoMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveIconInfoMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveIconInfoMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveIconInfoMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveIconInfoMethod "getBaseScale" o = IconInfoGetBaseScaleMethodInfo
    ResolveIconInfoMethod "getBaseSize" o = IconInfoGetBaseSizeMethodInfo
    ResolveIconInfoMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveIconInfoMethod "getFilename" o = IconInfoGetFilenameMethodInfo
    ResolveIconInfoMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveIconInfoMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveIconInfoMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveIconInfoMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveIconInfoMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveIconInfoMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveIconInfoMethod t IconInfo, O.MethodInfo info IconInfo p) => OL.IsLabel t (IconInfo -> 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 IconInfo
type instance O.AttributeList IconInfo = IconInfoAttributeList
type IconInfoAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method IconInfo::new_for_pixbuf
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "icon_theme"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkIconTheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixbuf"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pixbuf to wrap in a #GtkIconInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "IconInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_icon_info_new_for_pixbuf" gtk_icon_info_new_for_pixbuf :: 
    Ptr Gtk.IconTheme.IconTheme ->          -- icon_theme : TInterface (Name {namespace = "Gtk", name = "IconTheme"})
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- pixbuf : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO (Ptr IconInfo)

-- | Creates a t'GI.Gtk.Objects.IconInfo.IconInfo' for a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf'.
iconInfoNewForPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.IconTheme.IsIconTheme a, GdkPixbuf.Pixbuf.IsPixbuf b) =>
    a
    -- ^ /@iconTheme@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> b
    -- ^ /@pixbuf@/: the pixbuf to wrap in a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> m IconInfo
    -- ^ __Returns:__ a t'GI.Gtk.Objects.IconInfo.IconInfo'
iconInfoNewForPixbuf :: a -> b -> m IconInfo
iconInfoNewForPixbuf iconTheme :: a
iconTheme pixbuf :: b
pixbuf = IO IconInfo -> m IconInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconInfo -> m IconInfo) -> IO IconInfo -> m IconInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconTheme
iconTheme' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconTheme
    Ptr Pixbuf
pixbuf' <- b -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pixbuf
    Ptr IconInfo
result <- Ptr IconTheme -> Ptr Pixbuf -> IO (Ptr IconInfo)
gtk_icon_info_new_for_pixbuf Ptr IconTheme
iconTheme' Ptr Pixbuf
pixbuf'
    Text -> Ptr IconInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iconInfoNewForPixbuf" Ptr IconInfo
result
    IconInfo
result' <- ((ManagedPtr IconInfo -> IconInfo) -> Ptr IconInfo -> IO IconInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr IconInfo -> IconInfo
IconInfo) Ptr IconInfo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconTheme
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pixbuf
    IconInfo -> IO IconInfo
forall (m :: * -> *) a. Monad m => a -> m a
return IconInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method IconInfo::get_base_scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkIconInfo" , 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_icon_info_get_base_scale" gtk_icon_info_get_base_scale :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    IO Int32

-- | Gets the base scale for the icon. The base scale is a scale
-- for the icon that was specified by the icon theme creator.
-- For instance an icon drawn for a high-dpi monitor with window
-- scale 2 for a base size of 32 will be 64 pixels tall and have
-- a base scale of 2.
iconInfoGetBaseScale ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> m Int32
    -- ^ __Returns:__ the base scale
iconInfoGetBaseScale :: a -> m Int32
iconInfoGetBaseScale iconInfo :: a
iconInfo = 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 IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Int32
result <- Ptr IconInfo -> IO Int32
gtk_icon_info_get_base_scale Ptr IconInfo
iconInfo'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data IconInfoGetBaseScaleMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsIconInfo a) => O.MethodInfo IconInfoGetBaseScaleMethodInfo a signature where
    overloadedMethod = iconInfoGetBaseScale

#endif

-- method IconInfo::get_base_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkIconInfo" , 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_icon_info_get_base_size" gtk_icon_info_get_base_size :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    IO Int32

-- | Gets the base size for the icon. The base size
-- is a size for the icon that was specified by
-- the icon theme creator. This may be different
-- than the actual size of image;
-- These icons will be given
-- the same base size as the larger icons to which
-- they are attached.
-- 
-- Note that for scaled icons the base size does
-- not include the base scale.
iconInfoGetBaseSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> m Int32
    -- ^ __Returns:__ the base size, or 0, if no base
    --     size is known for the icon.
iconInfoGetBaseSize :: a -> m Int32
iconInfoGetBaseSize iconInfo :: a
iconInfo = 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 IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Int32
result <- Ptr IconInfo -> IO Int32
gtk_icon_info_get_base_size Ptr IconInfo
iconInfo'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data IconInfoGetBaseSizeMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsIconInfo a) => O.MethodInfo IconInfoGetBaseSizeMethodInfo a signature where
    overloadedMethod = iconInfoGetBaseSize

#endif

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

foreign import ccall "gtk_icon_info_get_filename" gtk_icon_info_get_filename :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    IO CString

-- | Gets the filename for the icon. If the 'GI.Gtk.Flags.IconLookupFlagsUseBuiltin'
-- flag was passed to 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon', there may be no
-- filename if a builtin icon is returned; in this case, you should
-- use @/gtk_icon_info_get_builtin_pixbuf()/@.
iconInfoGetFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> m (Maybe [Char])
    -- ^ __Returns:__ the filename for the icon, or 'P.Nothing'
    --     if @/gtk_icon_info_get_builtin_pixbuf()/@ should be used instead.
    --     The return value is owned by GTK+ and should not be modified
    --     or freed.
iconInfoGetFilename :: a -> m (Maybe [Char])
iconInfoGetFilename iconInfo :: a
iconInfo = IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> m (Maybe [Char]))
-> IO (Maybe [Char]) -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    CString
result <- Ptr IconInfo -> IO CString
gtk_icon_info_get_filename Ptr IconInfo
iconInfo'
    Maybe [Char]
maybeResult <- CString -> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO [Char]) -> IO (Maybe [Char]))
-> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        [Char]
result'' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result'
        [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
maybeResult

#if defined(ENABLE_OVERLOADING)
data IconInfoGetFilenameMethodInfo
instance (signature ~ (m (Maybe [Char])), MonadIO m, IsIconInfo a) => O.MethodInfo IconInfoGetFilenameMethodInfo a signature where
    overloadedMethod = iconInfoGetFilename

#endif

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

foreign import ccall "gtk_icon_info_is_symbolic" gtk_icon_info_is_symbolic :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    IO CInt

-- | Checks if the icon is symbolic or not. This currently uses only
-- the file name and not the file contents for determining this.
-- This behaviour may change in the future.
iconInfoIsSymbolic ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the icon is symbolic, 'P.False' otherwise
iconInfoIsSymbolic :: a -> m Bool
iconInfoIsSymbolic iconInfo :: a
iconInfo = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    CInt
result <- Ptr IconInfo -> IO CInt
gtk_icon_info_is_symbolic Ptr IconInfo
iconInfo'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IconInfoIsSymbolicMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsIconInfo a) => O.MethodInfo IconInfoIsSymbolicMethodInfo a signature where
    overloadedMethod = iconInfoIsSymbolic

#endif

-- method IconInfo::load_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GtkIconInfo from gtk_icon_theme_lookup_icon()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_icon_info_load_icon" gtk_icon_info_load_icon :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Renders an icon previously looked up in an icon theme using
-- 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'; the size will be based on the size
-- passed to 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'. Note that the resulting
-- pixbuf may not be exactly this size; an icon theme may have icons
-- that differ slightly from their nominal sizes, and in addition GTK+
-- will avoid scaling icons that it considers sufficiently close to the
-- requested size or for which the source image would have to be scaled
-- up too far. (This maintains sharpness.). This behaviour can be changed
-- by passing the 'GI.Gtk.Flags.IconLookupFlagsForceSize' flag when obtaining
-- the t'GI.Gtk.Objects.IconInfo.IconInfo'. If this flag has been specified, the pixbuf
-- returned by this function will be scaled to the exact size.
iconInfoLoadIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo' from 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'
    -> m GdkPixbuf.Pixbuf.Pixbuf
    -- ^ __Returns:__ the rendered icon; this may be a newly
    --     created icon or a new reference to an internal icon, so you must
    --     not modify the icon. Use 'GI.GObject.Objects.Object.objectUnref' to release your reference
    --     to the icon. /(Can throw 'Data.GI.Base.GError.GError')/
iconInfoLoadIcon :: a -> m Pixbuf
iconInfoLoadIcon iconInfo :: a
iconInfo = IO Pixbuf -> m Pixbuf
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pixbuf -> m Pixbuf) -> IO Pixbuf -> m Pixbuf
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    IO Pixbuf -> IO () -> IO Pixbuf
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Pixbuf
result <- (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ Ptr IconInfo -> Ptr (Ptr GError) -> IO (Ptr Pixbuf)
gtk_icon_info_load_icon Ptr IconInfo
iconInfo'
        Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iconInfoLoadIcon" Ptr Pixbuf
result
        Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
        Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadIconMethodInfo
instance (signature ~ (m GdkPixbuf.Pixbuf.Pixbuf), MonadIO m, IsIconInfo a) => O.MethodInfo IconInfoLoadIconMethodInfo a signature where
    overloadedMethod = iconInfoLoadIcon

#endif

-- method IconInfo::load_icon_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GtkIconInfo from gtk_icon_theme_lookup_icon()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncReadyCallback to call when the\n    request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , 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_info_load_icon_async" gtk_icon_info_load_icon_async :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously load, render and scale an icon previously looked up
-- from the icon theme using 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'.
-- 
-- For more details, see 'GI.Gtk.Objects.IconInfo.iconInfoLoadIcon' which is the synchronous
-- version of this call.
iconInfoLoadIconAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo' from 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the
    --     request is satisfied
    -> m ()
iconInfoLoadIconAsync :: a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
iconInfoLoadIconAsync iconInfo :: a
iconInfo cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr IconInfo
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_icon_info_load_icon_async Ptr IconInfo
iconInfo' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadIconAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsIconInfo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo IconInfoLoadIconAsyncMethodInfo a signature where
    overloadedMethod = iconInfoLoadIconAsync

#endif

-- method IconInfo::load_icon_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GtkIconInfo from gtk_icon_theme_lookup_icon()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_icon_info_load_icon_finish" gtk_icon_info_load_icon_finish :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Finishes an async icon load, see 'GI.Gtk.Objects.IconInfo.iconInfoLoadIconAsync'.
iconInfoLoadIconFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo' from 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m GdkPixbuf.Pixbuf.Pixbuf
    -- ^ __Returns:__ the rendered icon; this may be a newly
    --     created icon or a new reference to an internal icon, so you must
    --     not modify the icon. Use 'GI.GObject.Objects.Object.objectUnref' to release your reference
    --     to the icon. /(Can throw 'Data.GI.Base.GError.GError')/
iconInfoLoadIconFinish :: a -> b -> m Pixbuf
iconInfoLoadIconFinish iconInfo :: a
iconInfo res :: b
res = IO Pixbuf -> m Pixbuf
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pixbuf -> m Pixbuf) -> IO Pixbuf -> m Pixbuf
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO Pixbuf -> IO () -> IO Pixbuf
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Pixbuf
result <- (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ Ptr IconInfo
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Pixbuf)
gtk_icon_info_load_icon_finish Ptr IconInfo
iconInfo' Ptr AsyncResult
res'
        Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iconInfoLoadIconFinish" Ptr Pixbuf
result
        Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadIconFinishMethodInfo
instance (signature ~ (b -> m GdkPixbuf.Pixbuf.Pixbuf), MonadIO m, IsIconInfo a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo IconInfoLoadIconFinishMethodInfo a signature where
    overloadedMethod = iconInfoLoadIconFinish

#endif

-- method IconInfo::load_symbolic
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkIconInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fg"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GdkRGBA representing the foreground color of the icon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "success_color"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GdkRGBA representing the warning color\n    of the icon or %NULL to use the default color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "warning_color"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GdkRGBA representing the warning color\n    of the icon or %NULL to use the default color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error_color"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GdkRGBA representing the error color\n    of the icon or %NULL to use the default color (allow-none)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "was_symbolic"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #gboolean, returns whether the\n    loaded icon was a symbolic one and whether the @fg color was\n    applied to it."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_icon_info_load_symbolic" gtk_icon_info_load_symbolic :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr Gdk.RGBA.RGBA ->                    -- fg : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr Gdk.RGBA.RGBA ->                    -- success_color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr Gdk.RGBA.RGBA ->                    -- warning_color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr Gdk.RGBA.RGBA ->                    -- error_color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr CInt ->                             -- was_symbolic : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Loads an icon, modifying it to match the system colours for the foreground,
-- success, warning and error colors provided. If the icon is not a symbolic
-- one, the function will return the result from 'GI.Gtk.Objects.IconInfo.iconInfoLoadIcon'.
-- 
-- This allows loading symbolic icons that will match the system theme.
-- 
-- Unless you are implementing a widget, you will want to use
-- 'GI.Gio.Objects.ThemedIcon.themedIconNewWithDefaultFallbacks' to load the icon.
-- 
-- As implementation details, the icon loaded needs to be of SVG type,
-- contain the “symbolic” term as the last component of the icon name,
-- and use the “fg”, “success”, “warning” and “error” CSS styles in the
-- SVG file itself.
-- 
-- See the <http://www.freedesktop.org/wiki/SymbolicIcons Symbolic Icons Specification>
-- for more information about symbolic icons.
iconInfoLoadSymbolic ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> Gdk.RGBA.RGBA
    -- ^ /@fg@/: a t'GI.Gdk.Structs.RGBA.RGBA' representing the foreground color of the icon
    -> Maybe (Gdk.RGBA.RGBA)
    -- ^ /@successColor@/: a t'GI.Gdk.Structs.RGBA.RGBA' representing the warning color
    --     of the icon or 'P.Nothing' to use the default color
    -> Maybe (Gdk.RGBA.RGBA)
    -- ^ /@warningColor@/: a t'GI.Gdk.Structs.RGBA.RGBA' representing the warning color
    --     of the icon or 'P.Nothing' to use the default color
    -> Maybe (Gdk.RGBA.RGBA)
    -- ^ /@errorColor@/: a t'GI.Gdk.Structs.RGBA.RGBA' representing the error color
    --     of the icon or 'P.Nothing' to use the default color (allow-none)
    -> m ((GdkPixbuf.Pixbuf.Pixbuf, Bool))
    -- ^ __Returns:__ a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' representing the loaded icon /(Can throw 'Data.GI.Base.GError.GError')/
iconInfoLoadSymbolic :: a
-> RGBA
-> Maybe RGBA
-> Maybe RGBA
-> Maybe RGBA
-> m (Pixbuf, Bool)
iconInfoLoadSymbolic iconInfo :: a
iconInfo fg :: RGBA
fg successColor :: Maybe RGBA
successColor warningColor :: Maybe RGBA
warningColor errorColor :: Maybe RGBA
errorColor = IO (Pixbuf, Bool) -> m (Pixbuf, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pixbuf, Bool) -> m (Pixbuf, Bool))
-> IO (Pixbuf, Bool) -> m (Pixbuf, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Ptr RGBA
fg' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
fg
    Ptr RGBA
maybeSuccessColor <- case Maybe RGBA
successColor of
        Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just jSuccessColor :: RGBA
jSuccessColor -> do
            Ptr RGBA
jSuccessColor' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
jSuccessColor
            Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
jSuccessColor'
    Ptr RGBA
maybeWarningColor <- case Maybe RGBA
warningColor of
        Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just jWarningColor :: RGBA
jWarningColor -> do
            Ptr RGBA
jWarningColor' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
jWarningColor
            Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
jWarningColor'
    Ptr RGBA
maybeErrorColor <- case Maybe RGBA
errorColor of
        Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just jErrorColor :: RGBA
jErrorColor -> do
            Ptr RGBA
jErrorColor' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
jErrorColor
            Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
jErrorColor'
    Ptr CInt
wasSymbolic <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO (Pixbuf, Bool) -> IO () -> IO (Pixbuf, Bool)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Pixbuf
result <- (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ Ptr IconInfo
-> Ptr RGBA
-> Ptr RGBA
-> Ptr RGBA
-> Ptr RGBA
-> Ptr CInt
-> Ptr (Ptr GError)
-> IO (Ptr Pixbuf)
gtk_icon_info_load_symbolic Ptr IconInfo
iconInfo' Ptr RGBA
fg' Ptr RGBA
maybeSuccessColor Ptr RGBA
maybeWarningColor Ptr RGBA
maybeErrorColor Ptr CInt
wasSymbolic
        Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iconInfoLoadSymbolic" Ptr Pixbuf
result
        Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
        CInt
wasSymbolic' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wasSymbolic
        let wasSymbolic'' :: Bool
wasSymbolic'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
wasSymbolic'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
        RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
fg
        Maybe RGBA -> (RGBA -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RGBA
successColor RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe RGBA -> (RGBA -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RGBA
warningColor RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe RGBA -> (RGBA -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RGBA
errorColor RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
wasSymbolic
        (Pixbuf, Bool) -> IO (Pixbuf, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pixbuf
result', Bool
wasSymbolic'')
     ) (do
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
wasSymbolic
     )

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadSymbolicMethodInfo
instance (signature ~ (Gdk.RGBA.RGBA -> Maybe (Gdk.RGBA.RGBA) -> Maybe (Gdk.RGBA.RGBA) -> Maybe (Gdk.RGBA.RGBA) -> m ((GdkPixbuf.Pixbuf.Pixbuf, Bool))), MonadIO m, IsIconInfo a) => O.MethodInfo IconInfoLoadSymbolicMethodInfo a signature where
    overloadedMethod = iconInfoLoadSymbolic

#endif

-- method IconInfo::load_symbolic_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GtkIconInfo from gtk_icon_theme_lookup_icon()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fg"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GdkRGBA representing the foreground color of the icon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "success_color"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GdkRGBA representing the warning color\n    of the icon or %NULL to use the default color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "warning_color"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GdkRGBA representing the warning color\n    of the icon or %NULL to use the default color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error_color"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GdkRGBA representing the error color\n    of the icon or %NULL to use the default color (allow-none)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncReadyCallback to call when the\n    request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 7
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , 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_info_load_symbolic_async" gtk_icon_info_load_symbolic_async :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr Gdk.RGBA.RGBA ->                    -- fg : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr Gdk.RGBA.RGBA ->                    -- success_color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr Gdk.RGBA.RGBA ->                    -- warning_color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr Gdk.RGBA.RGBA ->                    -- error_color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously load, render and scale a symbolic icon previously looked up
-- from the icon theme using 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'.
-- 
-- For more details, see 'GI.Gtk.Objects.IconInfo.iconInfoLoadSymbolic' which is the synchronous
-- version of this call.
iconInfoLoadSymbolicAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo' from 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'
    -> Gdk.RGBA.RGBA
    -- ^ /@fg@/: a t'GI.Gdk.Structs.RGBA.RGBA' representing the foreground color of the icon
    -> Maybe (Gdk.RGBA.RGBA)
    -- ^ /@successColor@/: a t'GI.Gdk.Structs.RGBA.RGBA' representing the warning color
    --     of the icon or 'P.Nothing' to use the default color
    -> Maybe (Gdk.RGBA.RGBA)
    -- ^ /@warningColor@/: a t'GI.Gdk.Structs.RGBA.RGBA' representing the warning color
    --     of the icon or 'P.Nothing' to use the default color
    -> Maybe (Gdk.RGBA.RGBA)
    -- ^ /@errorColor@/: a t'GI.Gdk.Structs.RGBA.RGBA' representing the error color
    --     of the icon or 'P.Nothing' to use the default color (allow-none)
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the
    --     request is satisfied
    -> m ()
iconInfoLoadSymbolicAsync :: a
-> RGBA
-> Maybe RGBA
-> Maybe RGBA
-> Maybe RGBA
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
iconInfoLoadSymbolicAsync iconInfo :: a
iconInfo fg :: RGBA
fg successColor :: Maybe RGBA
successColor warningColor :: Maybe RGBA
warningColor errorColor :: Maybe RGBA
errorColor cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Ptr RGBA
fg' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
fg
    Ptr RGBA
maybeSuccessColor <- case Maybe RGBA
successColor of
        Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just jSuccessColor :: RGBA
jSuccessColor -> do
            Ptr RGBA
jSuccessColor' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
jSuccessColor
            Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
jSuccessColor'
    Ptr RGBA
maybeWarningColor <- case Maybe RGBA
warningColor of
        Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just jWarningColor :: RGBA
jWarningColor -> do
            Ptr RGBA
jWarningColor' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
jWarningColor
            Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
jWarningColor'
    Ptr RGBA
maybeErrorColor <- case Maybe RGBA
errorColor of
        Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just jErrorColor :: RGBA
jErrorColor -> do
            Ptr RGBA
jErrorColor' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
jErrorColor
            Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
jErrorColor'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr IconInfo
-> Ptr RGBA
-> Ptr RGBA
-> Ptr RGBA
-> Ptr RGBA
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_icon_info_load_symbolic_async Ptr IconInfo
iconInfo' Ptr RGBA
fg' Ptr RGBA
maybeSuccessColor Ptr RGBA
maybeWarningColor Ptr RGBA
maybeErrorColor Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
fg
    Maybe RGBA -> (RGBA -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RGBA
successColor RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe RGBA -> (RGBA -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RGBA
warningColor RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe RGBA -> (RGBA -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RGBA
errorColor RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadSymbolicAsyncMethodInfo
instance (signature ~ (Gdk.RGBA.RGBA -> Maybe (Gdk.RGBA.RGBA) -> Maybe (Gdk.RGBA.RGBA) -> Maybe (Gdk.RGBA.RGBA) -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsIconInfo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo IconInfoLoadSymbolicAsyncMethodInfo a signature where
    overloadedMethod = iconInfoLoadSymbolicAsync

#endif

-- method IconInfo::load_symbolic_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GtkIconInfo from gtk_icon_theme_lookup_icon()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "was_symbolic"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #gboolean, returns whether the\n    loaded icon was a symbolic one and whether the @fg color was\n    applied to it."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_icon_info_load_symbolic_finish" gtk_icon_info_load_symbolic_finish :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr CInt ->                             -- was_symbolic : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Finishes an async icon load, see 'GI.Gtk.Objects.IconInfo.iconInfoLoadSymbolicAsync'.
iconInfoLoadSymbolicFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo' from 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ((GdkPixbuf.Pixbuf.Pixbuf, Bool))
    -- ^ __Returns:__ the rendered icon; this may be a newly
    --     created icon or a new reference to an internal icon, so you must
    --     not modify the icon. Use 'GI.GObject.Objects.Object.objectUnref' to release your reference
    --     to the icon. /(Can throw 'Data.GI.Base.GError.GError')/
iconInfoLoadSymbolicFinish :: a -> b -> m (Pixbuf, Bool)
iconInfoLoadSymbolicFinish iconInfo :: a
iconInfo res :: b
res = IO (Pixbuf, Bool) -> m (Pixbuf, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pixbuf, Bool) -> m (Pixbuf, Bool))
-> IO (Pixbuf, Bool) -> m (Pixbuf, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    Ptr CInt
wasSymbolic <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO (Pixbuf, Bool) -> IO () -> IO (Pixbuf, Bool)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Pixbuf
result <- (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ Ptr IconInfo
-> Ptr AsyncResult
-> Ptr CInt
-> Ptr (Ptr GError)
-> IO (Ptr Pixbuf)
gtk_icon_info_load_symbolic_finish Ptr IconInfo
iconInfo' Ptr AsyncResult
res' Ptr CInt
wasSymbolic
        Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iconInfoLoadSymbolicFinish" Ptr Pixbuf
result
        Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
        CInt
wasSymbolic' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wasSymbolic
        let wasSymbolic'' :: Bool
wasSymbolic'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
wasSymbolic'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
wasSymbolic
        (Pixbuf, Bool) -> IO (Pixbuf, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pixbuf
result', Bool
wasSymbolic'')
     ) (do
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
wasSymbolic
     )

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadSymbolicFinishMethodInfo
instance (signature ~ (b -> m ((GdkPixbuf.Pixbuf.Pixbuf, Bool))), MonadIO m, IsIconInfo a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo IconInfoLoadSymbolicFinishMethodInfo a signature where
    overloadedMethod = iconInfoLoadSymbolicFinish

#endif

-- method IconInfo::load_symbolic_for_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkIconInfo" , 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
--           }
--       , Arg
--           { argCName = "was_symbolic"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #gboolean, returns whether the\n    loaded icon was a symbolic one and whether the foreground color was\n    applied to it."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_icon_info_load_symbolic_for_context" gtk_icon_info_load_symbolic_for_context :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr Gtk.StyleContext.StyleContext ->    -- context : TInterface (Name {namespace = "Gtk", name = "StyleContext"})
    Ptr CInt ->                             -- was_symbolic : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Loads an icon, modifying it to match the system colors for the foreground,
-- success, warning and error colors provided. If the icon is not a symbolic
-- one, the function will return the result from 'GI.Gtk.Objects.IconInfo.iconInfoLoadIcon'.
-- This function uses the regular foreground color and the symbolic colors
-- with the names “success_color”, “warning_color” and “error_color” from
-- the context.
-- 
-- This allows loading symbolic icons that will match the system theme.
-- 
-- See 'GI.Gtk.Objects.IconInfo.iconInfoLoadSymbolic' for more details.
iconInfoLoadSymbolicForContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a, Gtk.StyleContext.IsStyleContext b) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> b
    -- ^ /@context@/: a t'GI.Gtk.Objects.StyleContext.StyleContext'
    -> m ((GdkPixbuf.Pixbuf.Pixbuf, Bool))
    -- ^ __Returns:__ a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' representing the loaded icon /(Can throw 'Data.GI.Base.GError.GError')/
iconInfoLoadSymbolicForContext :: a -> b -> m (Pixbuf, Bool)
iconInfoLoadSymbolicForContext iconInfo :: a
iconInfo context :: b
context = IO (Pixbuf, Bool) -> m (Pixbuf, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pixbuf, Bool) -> m (Pixbuf, Bool))
-> IO (Pixbuf, Bool) -> m (Pixbuf, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Ptr StyleContext
context' <- b -> IO (Ptr StyleContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr CInt
wasSymbolic <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO (Pixbuf, Bool) -> IO () -> IO (Pixbuf, Bool)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Pixbuf
result <- (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ Ptr IconInfo
-> Ptr StyleContext
-> Ptr CInt
-> Ptr (Ptr GError)
-> IO (Ptr Pixbuf)
gtk_icon_info_load_symbolic_for_context Ptr IconInfo
iconInfo' Ptr StyleContext
context' Ptr CInt
wasSymbolic
        Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iconInfoLoadSymbolicForContext" Ptr Pixbuf
result
        Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
        CInt
wasSymbolic' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wasSymbolic
        let wasSymbolic'' :: Bool
wasSymbolic'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
wasSymbolic'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
wasSymbolic
        (Pixbuf, Bool) -> IO (Pixbuf, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pixbuf
result', Bool
wasSymbolic'')
     ) (do
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
wasSymbolic
     )

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadSymbolicForContextMethodInfo
instance (signature ~ (b -> m ((GdkPixbuf.Pixbuf.Pixbuf, Bool))), MonadIO m, IsIconInfo a, Gtk.StyleContext.IsStyleContext b) => O.MethodInfo IconInfoLoadSymbolicForContextMethodInfo a signature where
    overloadedMethod = iconInfoLoadSymbolicForContext

#endif

-- method IconInfo::load_symbolic_for_context_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GtkIconInfo from gtk_icon_theme_lookup_icon()"
--                 , 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
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncReadyCallback to call when the\n    request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , 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_info_load_symbolic_for_context_async" gtk_icon_info_load_symbolic_for_context_async :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr Gtk.StyleContext.StyleContext ->    -- context : TInterface (Name {namespace = "Gtk", name = "StyleContext"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously load, render and scale a symbolic icon previously
-- looked up from the icon theme using 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'.
-- 
-- For more details, see 'GI.Gtk.Objects.IconInfo.iconInfoLoadSymbolicForContext'
-- which is the synchronous version of this call.
iconInfoLoadSymbolicForContextAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a, Gtk.StyleContext.IsStyleContext b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo' from 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'
    -> b
    -- ^ /@context@/: a t'GI.Gtk.Objects.StyleContext.StyleContext'
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the
    --     request is satisfied
    -> m ()
iconInfoLoadSymbolicForContextAsync :: a -> b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
iconInfoLoadSymbolicForContextAsync iconInfo :: a
iconInfo context :: b
context cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Ptr StyleContext
context' <- b -> IO (Ptr StyleContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr IconInfo
-> Ptr StyleContext
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_icon_info_load_symbolic_for_context_async Ptr IconInfo
iconInfo' Ptr StyleContext
context' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadSymbolicForContextAsyncMethodInfo
instance (signature ~ (b -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsIconInfo a, Gtk.StyleContext.IsStyleContext b, Gio.Cancellable.IsCancellable c) => O.MethodInfo IconInfoLoadSymbolicForContextAsyncMethodInfo a signature where
    overloadedMethod = iconInfoLoadSymbolicForContextAsync

#endif

-- method IconInfo::load_symbolic_for_context_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "icon_info"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GtkIconInfo from gtk_icon_theme_lookup_icon()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "was_symbolic"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #gboolean, returns whether the\n    loaded icon was a symbolic one and whether the @fg color was\n    applied to it."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_icon_info_load_symbolic_for_context_finish" gtk_icon_info_load_symbolic_for_context_finish :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr CInt ->                             -- was_symbolic : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Finishes an async icon load, see 'GI.Gtk.Objects.IconInfo.iconInfoLoadSymbolicForContextAsync'.
iconInfoLoadSymbolicForContextFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo' from 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ((GdkPixbuf.Pixbuf.Pixbuf, Bool))
    -- ^ __Returns:__ the rendered icon; this may be a newly
    --     created icon or a new reference to an internal icon, so you must
    --     not modify the icon. Use 'GI.GObject.Objects.Object.objectUnref' to release your reference
    --     to the icon. /(Can throw 'Data.GI.Base.GError.GError')/
iconInfoLoadSymbolicForContextFinish :: a -> b -> m (Pixbuf, Bool)
iconInfoLoadSymbolicForContextFinish iconInfo :: a
iconInfo res :: b
res = IO (Pixbuf, Bool) -> m (Pixbuf, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pixbuf, Bool) -> m (Pixbuf, Bool))
-> IO (Pixbuf, Bool) -> m (Pixbuf, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    Ptr CInt
wasSymbolic <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO (Pixbuf, Bool) -> IO () -> IO (Pixbuf, Bool)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Pixbuf
result <- (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr GError) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ Ptr IconInfo
-> Ptr AsyncResult
-> Ptr CInt
-> Ptr (Ptr GError)
-> IO (Ptr Pixbuf)
gtk_icon_info_load_symbolic_for_context_finish Ptr IconInfo
iconInfo' Ptr AsyncResult
res' Ptr CInt
wasSymbolic
        Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iconInfoLoadSymbolicForContextFinish" Ptr Pixbuf
result
        Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
        CInt
wasSymbolic' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wasSymbolic
        let wasSymbolic'' :: Bool
wasSymbolic'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
wasSymbolic'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
wasSymbolic
        (Pixbuf, Bool) -> IO (Pixbuf, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pixbuf
result', Bool
wasSymbolic'')
     ) (do
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
wasSymbolic
     )

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadSymbolicForContextFinishMethodInfo
instance (signature ~ (b -> m ((GdkPixbuf.Pixbuf.Pixbuf, Bool))), MonadIO m, IsIconInfo a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo IconInfoLoadSymbolicForContextFinishMethodInfo a signature where
    overloadedMethod = iconInfoLoadSymbolicForContextFinish

#endif

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

foreign import ccall "gtk_icon_info_load_texture" gtk_icon_info_load_texture :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    IO (Ptr Gdk.Texture.Texture)

-- | Returns a texture object that can be used to render the icon
-- with GSK.
iconInfoLoadTexture ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> m Gdk.Texture.Texture
    -- ^ __Returns:__ the icon texture; this may be a newly
    --     created texture or a new reference to an exiting texture. Use
    --     'GI.GObject.Objects.Object.objectUnref' to release your reference.
iconInfoLoadTexture :: a -> m Texture
iconInfoLoadTexture iconInfo :: a
iconInfo = IO Texture -> m Texture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture) -> IO Texture -> m Texture
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconInfo
iconInfo' <- a -> IO (Ptr IconInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iconInfo
    Ptr Texture
result <- Ptr IconInfo -> IO (Ptr Texture)
gtk_icon_info_load_texture Ptr IconInfo
iconInfo'
    Text -> Ptr Texture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "iconInfoLoadTexture" Ptr Texture
result
    Texture
result' <- ((ManagedPtr Texture -> Texture) -> Ptr Texture -> IO Texture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Texture -> Texture
Gdk.Texture.Texture) Ptr Texture
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    Texture -> IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
result'

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadTextureMethodInfo
instance (signature ~ (m Gdk.Texture.Texture), MonadIO m, IsIconInfo a) => O.MethodInfo IconInfoLoadTextureMethodInfo a signature where
    overloadedMethod = iconInfoLoadTexture

#endif