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


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

#if defined(ENABLE_OVERLOADING)
    ResolveIconInfoMethod                   ,
#endif


-- ** getAttachPoints #method:getAttachPoints#

#if defined(ENABLE_OVERLOADING)
    IconInfoGetAttachPointsMethodInfo       ,
#endif
    iconInfoGetAttachPoints                 ,


-- ** getBaseScale #method:getBaseScale#

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


-- ** getBaseSize #method:getBaseSize#

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


-- ** getBuiltinPixbuf #method:getBuiltinPixbuf#

#if defined(ENABLE_OVERLOADING)
    IconInfoGetBuiltinPixbufMethodInfo      ,
#endif
    iconInfoGetBuiltinPixbuf                ,


-- ** getDisplayName #method:getDisplayName#

#if defined(ENABLE_OVERLOADING)
    IconInfoGetDisplayNameMethodInfo        ,
#endif
    iconInfoGetDisplayName                  ,


-- ** getEmbeddedRect #method:getEmbeddedRect#

#if defined(ENABLE_OVERLOADING)
    IconInfoGetEmbeddedRectMethodInfo       ,
#endif
    iconInfoGetEmbeddedRect                 ,


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


-- ** loadSurface #method:loadSurface#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadSurfaceMethodInfo           ,
#endif
    iconInfoLoadSurface                     ,


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


-- ** loadSymbolicForStyle #method:loadSymbolicForStyle#

#if defined(ENABLE_OVERLOADING)
    IconInfoLoadSymbolicForStyleMethodInfo  ,
#endif
    iconInfoLoadSymbolicForStyle            ,


-- ** newForPixbuf #method:newForPixbuf#

    iconInfoNewForPixbuf                    ,


-- ** setRawCoordinates #method:setRawCoordinates#

#if defined(ENABLE_OVERLOADING)
    IconInfoSetRawCoordinatesMethodInfo     ,
#endif
    iconInfoSetRawCoordinates               ,




    ) 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 Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.Window as Gdk.Window
import qualified GI.Gdk.Structs.Point as Gdk.Point
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
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.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Objects.IconTheme as Gtk.IconTheme
import {-# SOURCE #-} qualified GI.Gtk.Objects.Style as Gtk.Style
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 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 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

#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 "loadSurface" o = IconInfoLoadSurfaceMethodInfo
    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 "loadSymbolicForStyle" o = IconInfoLoadSymbolicForStyleMethodInfo
    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 "getAttachPoints" o = IconInfoGetAttachPointsMethodInfo
    ResolveIconInfoMethod "getBaseScale" o = IconInfoGetBaseScaleMethodInfo
    ResolveIconInfoMethod "getBaseSize" o = IconInfoGetBaseSizeMethodInfo
    ResolveIconInfoMethod "getBuiltinPixbuf" o = IconInfoGetBuiltinPixbufMethodInfo
    ResolveIconInfoMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveIconInfoMethod "getDisplayName" o = IconInfoGetDisplayNameMethodInfo
    ResolveIconInfoMethod "getEmbeddedRect" o = IconInfoGetEmbeddedRectMethodInfo
    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 "setRawCoordinates" o = IconInfoSetRawCoordinatesMethodInfo
    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'.
-- 
-- /Since: 2.14/
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 a
iconTheme 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 Text
"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_attach_points
-- 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 = "points"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Gdk" , name = "Point" })
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store pointer\n    to an array of points, or %NULL free the array of points with g_free()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "n_points"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the number of points in @points,\n    or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_points"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "location to store the number of points in @points,\n    or %NULL"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_icon_info_get_attach_points" gtk_icon_info_get_attach_points :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr (Ptr Gdk.Point.Point) ->            -- points : TCArray False (-1) 2 (TInterface (Name {namespace = "Gdk", name = "Point"}))
    Ptr Int32 ->                            -- n_points : TBasicType TInt
    IO CInt

{-# DEPRECATED iconInfoGetAttachPoints ["(Since version 3.14)","Attachment points are deprecated"] #-}
-- | This function is deprecated and always returns 'P.False'.
-- 
-- /Since: 2.4/
iconInfoGetAttachPoints ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> m ((Bool, [Gdk.Point.Point]))
    -- ^ __Returns:__ 'P.False'
iconInfoGetAttachPoints :: a -> m (Bool, [Point])
iconInfoGetAttachPoints a
iconInfo = IO (Bool, [Point]) -> m (Bool, [Point])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, [Point]) -> m (Bool, [Point]))
-> IO (Bool, [Point]) -> m (Bool, [Point])
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 (Ptr Point)
points <- IO (Ptr (Ptr Point))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gdk.Point.Point))
    Ptr Int32
nPoints <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr IconInfo -> Ptr (Ptr Point) -> Ptr Int32 -> IO CInt
gtk_icon_info_get_attach_points Ptr IconInfo
iconInfo' Ptr (Ptr Point)
points Ptr Int32
nPoints
    Int32
nPoints' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
nPoints
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Point
points' <- Ptr (Ptr Point) -> IO (Ptr Point)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Point)
points
    [Ptr Point]
points'' <- (Int -> Int32 -> Ptr Point -> IO [Ptr Point]
forall a b. Integral a => Int -> a -> Ptr b -> IO [Ptr b]
unpackBlockArrayWithLength Int
8 Int32
nPoints') Ptr Point
points'
    [Point]
points''' <- (Ptr Point -> IO Point) -> [Ptr Point] -> IO [Point]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Point -> Point
Gdk.Point.Point) [Ptr Point]
points''
    Ptr Point -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Point
points'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    Ptr (Ptr Point) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Point)
points
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
nPoints
    (Bool, [Point]) -> IO (Bool, [Point])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', [Point]
points''')

#if defined(ENABLE_OVERLOADING)
data IconInfoGetAttachPointsMethodInfo
instance (signature ~ (m ((Bool, [Gdk.Point.Point]))), MonadIO m, IsIconInfo a) => O.MethodInfo IconInfoGetAttachPointsMethodInfo a signature where
    overloadedMethod = iconInfoGetAttachPoints

#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 screen with window
-- scale 2 for a base size of 32 will be 64 pixels tall and have
-- a base scale of 2.
-- 
-- /Since: 3.10/
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 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; an example of
-- this is small emblem icons that can be attached
-- to a larger icon. 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.
-- 
-- /Since: 2.4/
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 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_builtin_pixbuf
-- 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 = "GdkPixbuf" , name = "Pixbuf" })
-- throws : False
-- Skip return : False

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

{-# DEPRECATED iconInfoGetBuiltinPixbuf ["(Since version 3.14)","This function is deprecated, use","    'GI.Gtk.Objects.IconTheme.iconThemeAddResourcePath' instead of builtin icons."] #-}
-- | Gets the built-in image for this icon, if any. To allow GTK+ to use
-- built in icon images, you must pass the 'GI.Gtk.Flags.IconLookupFlagsUseBuiltin'
-- to 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'.
-- 
-- /Since: 2.4/
iconInfoGetBuiltinPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    -- ^ __Returns:__ the built-in image pixbuf, or 'P.Nothing'.
    --     No extra reference is added to the returned pixbuf, so if
    --     you want to keep it around, you must use 'GI.GObject.Objects.Object.objectRef'.
    --     The returned image must not be modified.
iconInfoGetBuiltinPixbuf :: a -> m (Maybe Pixbuf)
iconInfoGetBuiltinPixbuf a
iconInfo = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> m (Maybe 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 Pixbuf
result <- Ptr IconInfo -> IO (Ptr Pixbuf)
gtk_icon_info_get_builtin_pixbuf Ptr IconInfo
iconInfo'
    Maybe Pixbuf
maybeResult <- Ptr Pixbuf -> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pixbuf
result ((Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf))
-> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
result' -> do
        Pixbuf
result'' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result'
        Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    Maybe Pixbuf -> IO (Maybe Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
maybeResult

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

#endif

-- method IconInfo::get_display_name
-- 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 TUTF8)
-- throws : False
-- Skip return : False

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

{-# DEPRECATED iconInfoGetDisplayName ["(Since version 3.14)","Display names are deprecated"] #-}
-- | This function is deprecated and always returns 'P.Nothing'.
-- 
-- /Since: 2.4/
iconInfoGetDisplayName ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> m T.Text
    -- ^ __Returns:__ 'P.Nothing'
iconInfoGetDisplayName :: a -> m Text
iconInfoGetDisplayName a
iconInfo = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
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_display_name Ptr IconInfo
iconInfo'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconInfoGetDisplayName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IconInfoGetDisplayNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIconInfo a) => O.MethodInfo IconInfoGetDisplayNameMethodInfo a signature where
    overloadedMethod = iconInfoGetDisplayName

#endif

-- method IconInfo::get_embedded_rect
-- 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 = "rectangle"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "#GdkRectangle in which to store embedded\n  rectangle coordinates; coordinates are only stored\n  when this function returns %TRUE."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

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

{-# DEPRECATED iconInfoGetEmbeddedRect ["(Since version 3.14)","Embedded rectangles are deprecated"] #-}
-- | This function is deprecated and always returns 'P.False'.
-- 
-- /Since: 2.4/
iconInfoGetEmbeddedRect ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> m ((Bool, Gdk.Rectangle.Rectangle))
    -- ^ __Returns:__ 'P.False'
iconInfoGetEmbeddedRect :: a -> m (Bool, Rectangle)
iconInfoGetEmbeddedRect a
iconInfo = IO (Bool, Rectangle) -> m (Bool, Rectangle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Rectangle) -> m (Bool, Rectangle))
-> IO (Bool, Rectangle) -> m (Bool, Rectangle)
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 Rectangle
rectangle <- Int -> IO (Ptr Rectangle)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes Int
16 :: IO (Ptr Gdk.Rectangle.Rectangle)
    CInt
result <- Ptr IconInfo -> Ptr Rectangle -> IO CInt
gtk_icon_info_get_embedded_rect Ptr IconInfo
iconInfo' Ptr Rectangle
rectangle
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Rectangle
rectangle' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Gdk.Rectangle.Rectangle) Ptr Rectangle
rectangle
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    (Bool, Rectangle) -> IO (Bool, Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Rectangle
rectangle')

#if defined(ENABLE_OVERLOADING)
data IconInfoGetEmbeddedRectMethodInfo
instance (signature ~ (m ((Bool, Gdk.Rectangle.Rectangle))), MonadIO m, IsIconInfo a) => O.MethodInfo IconInfoGetEmbeddedRectMethodInfo a signature where
    overloadedMethod = iconInfoGetEmbeddedRect

#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 'GI.Gtk.Objects.IconInfo.iconInfoGetBuiltinPixbuf'.
-- 
-- /Since: 2.4/
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 'GI.Gtk.Objects.IconInfo.iconInfoGetBuiltinPixbuf' should be used instead.
    --     The return value is owned by GTK+ and should not be modified
    --     or freed.
iconInfoGetFilename :: a -> m (Maybe [Char])
iconInfoGetFilename 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
$ \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.
-- 
-- /Since: 3.12/
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 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
/= CInt
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.
-- 
-- /Since: 2.4/
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 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 Text
"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.
-- 
-- /Since: 3.8/
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 a
iconInfo Maybe b
cancellable 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
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just 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
        Maybe AsyncReadyCallback
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 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'.
-- 
-- /Since: 3.8/
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 a
iconInfo 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 Text
"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_surface
-- 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 = "for_window"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GdkWindow to optimize drawing for, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "Surface" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_icon_info_load_surface" gtk_icon_info_load_surface :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr Gdk.Window.Window ->                -- for_window : TInterface (Name {namespace = "Gdk", name = "Window"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Cairo.Surface.Surface)

-- | 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
-- surface 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.
-- 
-- /Since: 3.10/
iconInfoLoadSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a, Gdk.Window.IsWindow b) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo' from 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon'
    -> Maybe (b)
    -- ^ /@forWindow@/: t'GI.Gdk.Objects.Window.Window' to optimize drawing for, or 'P.Nothing'
    -> m Cairo.Surface.Surface
    -- ^ __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 @/cairo_surface_destroy()/@ to release your
    --     reference to the icon. /(Can throw 'Data.GI.Base.GError.GError')/
iconInfoLoadSurface :: a -> Maybe b -> m Surface
iconInfoLoadSurface a
iconInfo Maybe b
forWindow = IO Surface -> m Surface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
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 Window
maybeForWindow <- case Maybe b
forWindow of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
nullPtr
        Just b
jForWindow -> do
            Ptr Window
jForWindow' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jForWindow
            Ptr Window -> IO (Ptr Window)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jForWindow'
    IO Surface -> IO () -> IO Surface
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Surface
result <- (Ptr (Ptr GError) -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr (Ptr GError) -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. (a -> b) -> a -> b
$ Ptr IconInfo -> Ptr Window -> Ptr (Ptr GError) -> IO (Ptr Surface)
gtk_icon_info_load_surface Ptr IconInfo
iconInfo' Ptr Window
maybeForWindow
        Text -> Ptr Surface -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconInfoLoadSurface" Ptr Surface
result
        Surface
result' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Surface -> Surface
Cairo.Surface.Surface) Ptr Surface
result
        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
forWindow b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Surface -> IO Surface
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data IconInfoLoadSurfaceMethodInfo
instance (signature ~ (Maybe (b) -> m Cairo.Surface.Surface), MonadIO m, IsIconInfo a, Gdk.Window.IsWindow b) => O.MethodInfo IconInfoLoadSurfaceMethodInfo a signature where
    overloadedMethod = iconInfoLoadSurface

#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.
-- 
-- /Since: 3.0/
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 a
iconInfo RGBA
fg Maybe RGBA
successColor Maybe RGBA
warningColor 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
        Maybe RGBA
Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just 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
        Maybe RGBA
Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just 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
        Maybe RGBA
Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just 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 Text
"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
/= CInt
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.
-- 
-- /Since: 3.8/
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 a
iconInfo RGBA
fg Maybe RGBA
successColor Maybe RGBA
warningColor Maybe RGBA
errorColor Maybe b
cancellable 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
        Maybe RGBA
Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just 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
        Maybe RGBA
Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just 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
        Maybe RGBA
Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just 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
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just 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
        Maybe AsyncReadyCallback
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 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'.
-- 
-- /Since: 3.8/
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 a
iconInfo 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 Text
"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
/= CInt
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 @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" 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.
-- 
-- /Since: 3.0/
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 a
iconInfo 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 Text
"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
/= CInt
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.
-- 
-- /Since: 3.8/
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 a
iconInfo b
context Maybe c
cancellable 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
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just 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
        Maybe AsyncReadyCallback
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 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'.
-- 
-- /Since: 3.8/
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 a
iconInfo 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 Text
"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
/= CInt
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_symbolic_for_style
-- 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 = "style"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Style" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkStyle to take the colors from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StateType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the widget state to use for colors"
--                 , 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_style" gtk_icon_info_load_symbolic_for_style :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    Ptr Gtk.Style.Style ->                  -- style : TInterface (Name {namespace = "Gtk", name = "Style"})
    CUInt ->                                -- state : TInterface (Name {namespace = "Gtk", name = "StateType"})
    Ptr CInt ->                             -- was_symbolic : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

{-# DEPRECATED iconInfoLoadSymbolicForStyle ["(Since version 3.0)","Use 'GI.Gtk.Objects.IconInfo.iconInfoLoadSymbolicForContext' instead"] #-}
-- | 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.
-- 
-- See 'GI.Gtk.Objects.IconInfo.iconInfoLoadSymbolic' for more details.
-- 
-- /Since: 3.0/
iconInfoLoadSymbolicForStyle ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a, Gtk.Style.IsStyle b) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> b
    -- ^ /@style@/: a t'GI.Gtk.Objects.Style.Style' to take the colors from
    -> Gtk.Enums.StateType
    -- ^ /@state@/: the widget state to use for colors
    -> m ((GdkPixbuf.Pixbuf.Pixbuf, Bool))
    -- ^ __Returns:__ a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' representing the loaded icon /(Can throw 'Data.GI.Base.GError.GError')/
iconInfoLoadSymbolicForStyle :: a -> b -> StateType -> m (Pixbuf, Bool)
iconInfoLoadSymbolicForStyle a
iconInfo b
style StateType
state = 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 Style
style' <- b -> IO (Ptr Style)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
style
    let state' :: CUInt
state' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StateType -> Int) -> StateType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateType -> Int
forall a. Enum a => a -> Int
fromEnum) StateType
state
    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 Style
-> CUInt
-> Ptr CInt
-> Ptr (Ptr GError)
-> IO (Ptr Pixbuf)
gtk_icon_info_load_symbolic_for_style Ptr IconInfo
iconInfo' Ptr Style
style' CUInt
state' Ptr CInt
wasSymbolic
        Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconInfoLoadSymbolicForStyle" 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
/= CInt
0) CInt
wasSymbolic'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
style
        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 IconInfoLoadSymbolicForStyleMethodInfo
instance (signature ~ (b -> Gtk.Enums.StateType -> m ((GdkPixbuf.Pixbuf.Pixbuf, Bool))), MonadIO m, IsIconInfo a, Gtk.Style.IsStyle b) => O.MethodInfo IconInfoLoadSymbolicForStyleMethodInfo a signature where
    overloadedMethod = iconInfoLoadSymbolicForStyle

#endif

-- method IconInfo::set_raw_coordinates
-- 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 = "raw_coordinates"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether the coordinates of embedded rectangles\n    and attached points should be returned in their original\n    (unscaled) form."
--                 , 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_set_raw_coordinates" gtk_icon_info_set_raw_coordinates :: 
    Ptr IconInfo ->                         -- icon_info : TInterface (Name {namespace = "Gtk", name = "IconInfo"})
    CInt ->                                 -- raw_coordinates : TBasicType TBoolean
    IO ()

{-# DEPRECATED iconInfoSetRawCoordinates ["(Since version 3.14)","Embedded rectangles and attachment points are deprecated"] #-}
-- | Sets whether the coordinates returned by 'GI.Gtk.Objects.IconInfo.iconInfoGetEmbeddedRect'
-- and 'GI.Gtk.Objects.IconInfo.iconInfoGetAttachPoints' should be returned in their
-- original form as specified in the icon theme, instead of scaled
-- appropriately for the pixbuf returned by 'GI.Gtk.Objects.IconInfo.iconInfoLoadIcon'.
-- 
-- Raw coordinates are somewhat strange; they are specified to be with
-- respect to the unscaled pixmap for PNG and XPM icons, but for SVG
-- icons, they are in a 1000x1000 coordinate space that is scaled
-- to the final size of the icon.  You can determine if the icon is an SVG
-- icon by using 'GI.Gtk.Objects.IconInfo.iconInfoGetFilename', and seeing if it is non-'P.Nothing'
-- and ends in “.svg”.
-- 
-- This function is provided primarily to allow compatibility wrappers
-- for older API\'s, and is not expected to be useful for applications.
-- 
-- /Since: 2.4/
iconInfoSetRawCoordinates ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconInfo a) =>
    a
    -- ^ /@iconInfo@/: a t'GI.Gtk.Objects.IconInfo.IconInfo'
    -> Bool
    -- ^ /@rawCoordinates@/: whether the coordinates of embedded rectangles
    --     and attached points should be returned in their original
    --     (unscaled) form.
    -> m ()
iconInfoSetRawCoordinates :: a -> Bool -> m ()
iconInfoSetRawCoordinates a
iconInfo Bool
rawCoordinates = 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
    let rawCoordinates' :: CInt
rawCoordinates' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
rawCoordinates
    Ptr IconInfo -> CInt -> IO ()
gtk_icon_info_set_raw_coordinates Ptr IconInfo
iconInfo' CInt
rawCoordinates'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iconInfo
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif