{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Objects.IconTheme.IconTheme' provides a facility for looking up icons by name
-- and size. The main reason for using a name rather than simply
-- providing a filename is to allow different icons to be used
-- depending on what “icon theme” is selected
-- by the user. The operation of icon themes on Linux and Unix
-- follows the <http://www.freedesktop.org/Standards/icon-theme-spec Icon Theme Specification>
-- There is a fallback icon theme, named @hicolor@, where applications
-- should install their icons, but additional icon themes can be installed
-- as operating system vendors and users choose.
-- 
-- In many cases, named themes are used indirectly, via t'GI.Gtk.Objects.Image.Image'
-- rather than directly, but looking up icons
-- directly is also simple. The t'GI.Gtk.Objects.IconTheme.IconTheme' object acts
-- as a database of all the icons in the current theme. You
-- can create new t'GI.Gtk.Objects.IconTheme.IconTheme' objects, but it’s much more
-- efficient to use the standard icon theme of the t'GI.Gtk.Objects.Widget.Widget'
-- so that the icon information is shared with other people
-- looking up icons.
-- 
-- === /C code/
-- >
-- >GtkIconTheme *icon_theme;
-- >GtkIconPaintable *icon;
-- >GdkPaintable *paintable;
-- >
-- >icon_theme = gtk_icon_theme_get_for_display (gtk_widget_get_display (my_widget));
-- >icon = gtk_icon_theme_lookup_icon (icon_theme,
-- >                                   "my-icon-name", // icon name
-- >                                   48, // icon size
-- >                                   1,  // scale
-- >                                   0,  // flags);
-- > paintable = GDK_PAINTABLE (icon);
-- > // Use the paintable
-- > g_object_unref (icon);
-- 

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

module GI.Gtk.Objects.IconTheme
    ( 

-- * Exported types
    IconTheme(..)                           ,
    IsIconTheme                             ,
    toIconTheme                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveIconThemeMethod                  ,
#endif


-- ** addResourcePath #method:addResourcePath#

#if defined(ENABLE_OVERLOADING)
    IconThemeAddResourcePathMethodInfo      ,
#endif
    iconThemeAddResourcePath                ,


-- ** addSearchPath #method:addSearchPath#

#if defined(ENABLE_OVERLOADING)
    IconThemeAddSearchPathMethodInfo        ,
#endif
    iconThemeAddSearchPath                  ,


-- ** getForDisplay #method:getForDisplay#

    iconThemeGetForDisplay                  ,


-- ** getIconNames #method:getIconNames#

#if defined(ENABLE_OVERLOADING)
    IconThemeGetIconNamesMethodInfo         ,
#endif
    iconThemeGetIconNames                   ,


-- ** getIconSizes #method:getIconSizes#

#if defined(ENABLE_OVERLOADING)
    IconThemeGetIconSizesMethodInfo         ,
#endif
    iconThemeGetIconSizes                   ,


-- ** getResourcePath #method:getResourcePath#

#if defined(ENABLE_OVERLOADING)
    IconThemeGetResourcePathMethodInfo      ,
#endif
    iconThemeGetResourcePath                ,


-- ** getSearchPath #method:getSearchPath#

#if defined(ENABLE_OVERLOADING)
    IconThemeGetSearchPathMethodInfo        ,
#endif
    iconThemeGetSearchPath                  ,


-- ** getThemeName #method:getThemeName#

#if defined(ENABLE_OVERLOADING)
    IconThemeGetThemeNameMethodInfo         ,
#endif
    iconThemeGetThemeName                   ,


-- ** hasIcon #method:hasIcon#

#if defined(ENABLE_OVERLOADING)
    IconThemeHasIconMethodInfo              ,
#endif
    iconThemeHasIcon                        ,


-- ** lookupByGicon #method:lookupByGicon#

#if defined(ENABLE_OVERLOADING)
    IconThemeLookupByGiconMethodInfo        ,
#endif
    iconThemeLookupByGicon                  ,


-- ** lookupIcon #method:lookupIcon#

#if defined(ENABLE_OVERLOADING)
    IconThemeLookupIconMethodInfo           ,
#endif
    iconThemeLookupIcon                     ,


-- ** new #method:new#

    iconThemeNew                            ,


-- ** setResourcePath #method:setResourcePath#

#if defined(ENABLE_OVERLOADING)
    IconThemeSetResourcePathMethodInfo      ,
#endif
    iconThemeSetResourcePath                ,


-- ** setSearchPath #method:setSearchPath#

#if defined(ENABLE_OVERLOADING)
    IconThemeSetSearchPathMethodInfo        ,
#endif
    iconThemeSetSearchPath                  ,


-- ** setThemeName #method:setThemeName#

#if defined(ENABLE_OVERLOADING)
    IconThemeSetThemeNameMethodInfo         ,
#endif
    iconThemeSetThemeName                   ,




 -- * Properties
-- ** display #attr:display#
-- | The display that this icon theme object is attached to.

#if defined(ENABLE_OVERLOADING)
    IconThemeDisplayPropertyInfo            ,
#endif
    clearIconThemeDisplay                   ,
    constructIconThemeDisplay               ,
    getIconThemeDisplay                     ,
#if defined(ENABLE_OVERLOADING)
    iconThemeDisplay                        ,
#endif
    setIconThemeDisplay                     ,


-- ** iconNames #attr:iconNames#
-- | The icon names that are supported by the icon theme.

#if defined(ENABLE_OVERLOADING)
    IconThemeIconNamesPropertyInfo          ,
#endif
    getIconThemeIconNames                   ,
#if defined(ENABLE_OVERLOADING)
    iconThemeIconNames                      ,
#endif


-- ** resourcePath #attr:resourcePath#
-- | Resource paths that will be looked at when looking for icons,
-- similar to search paths.
-- 
-- The resources are considered as part of the hicolor icon theme
-- and must be located in subdirectories that are defined in the
-- hicolor icon theme, such as @\@path\/16x16\/actions\/run.png@.
-- Icons that are directly placed in the resource path instead
-- of a subdirectory are also considered as ultimate fallback.

#if defined(ENABLE_OVERLOADING)
    IconThemeResourcePathPropertyInfo       ,
#endif
    clearIconThemeResourcePath              ,
    constructIconThemeResourcePath          ,
    getIconThemeResourcePath                ,
#if defined(ENABLE_OVERLOADING)
    iconThemeResourcePath                   ,
#endif
    setIconThemeResourcePath                ,


-- ** searchPath #attr:searchPath#
-- | The search path for this icon theme.
-- 
-- When looking for icons, GTK will search for a subdirectory of
-- one or more of the directories in the search path with the same
-- name as the icon theme containing an index.theme file. (Themes
-- from multiple of the path elements are combined to allow themes
-- to be extended by adding icons in the user’s home directory.)

#if defined(ENABLE_OVERLOADING)
    IconThemeSearchPathPropertyInfo         ,
#endif
    clearIconThemeSearchPath                ,
    constructIconThemeSearchPath            ,
    getIconThemeSearchPath                  ,
#if defined(ENABLE_OVERLOADING)
    iconThemeSearchPath                     ,
#endif
    setIconThemeSearchPath                  ,


-- ** themeName #attr:themeName#
-- | The name of the icon theme that is being used.
-- 
-- Unless set to a different value, this will be the value of
-- the t'GI.Gtk.Objects.Settings.Settings':@/gtk-icon-theme-name/@ property of the t'GI.Gtk.Objects.Settings.Settings'
-- object associated to the display of the icontheme object.

#if defined(ENABLE_OVERLOADING)
    IconThemeThemeNamePropertyInfo          ,
#endif
    clearIconThemeThemeName                 ,
    constructIconThemeThemeName             ,
    getIconThemeThemeName                   ,
#if defined(ENABLE_OVERLOADING)
    iconThemeThemeName                      ,
#endif
    setIconThemeThemeName                   ,




 -- * Signals
-- ** changed #signal:changed#

    C_IconThemeChangedCallback              ,
    IconThemeChangedCallback                ,
#if defined(ENABLE_OVERLOADING)
    IconThemeChangedSignalInfo              ,
#endif
    afterIconThemeChanged                   ,
    genClosure_IconThemeChanged             ,
    mk_IconThemeChangedCallback             ,
    noIconThemeChangedCallback              ,
    onIconThemeChanged                      ,
    wrap_IconThemeChangedCallback           ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.Display as Gdk.Display
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Objects.IconPaintable as Gtk.IconPaintable

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

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

foreign import ccall "gtk_icon_theme_get_type"
    c_gtk_icon_theme_get_type :: IO B.Types.GType

instance B.Types.TypedObject IconTheme where
    glibType :: IO GType
glibType = IO GType
c_gtk_icon_theme_get_type

instance B.Types.GObject IconTheme

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveIconThemeMethod (t :: Symbol) (o :: *) :: * where
    ResolveIconThemeMethod "addResourcePath" o = IconThemeAddResourcePathMethodInfo
    ResolveIconThemeMethod "addSearchPath" o = IconThemeAddSearchPathMethodInfo
    ResolveIconThemeMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveIconThemeMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveIconThemeMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveIconThemeMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveIconThemeMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveIconThemeMethod "hasIcon" o = IconThemeHasIconMethodInfo
    ResolveIconThemeMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveIconThemeMethod "lookupByGicon" o = IconThemeLookupByGiconMethodInfo
    ResolveIconThemeMethod "lookupIcon" o = IconThemeLookupIconMethodInfo
    ResolveIconThemeMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveIconThemeMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveIconThemeMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveIconThemeMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveIconThemeMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveIconThemeMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveIconThemeMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveIconThemeMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveIconThemeMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveIconThemeMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveIconThemeMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveIconThemeMethod "getIconNames" o = IconThemeGetIconNamesMethodInfo
    ResolveIconThemeMethod "getIconSizes" o = IconThemeGetIconSizesMethodInfo
    ResolveIconThemeMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveIconThemeMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveIconThemeMethod "getResourcePath" o = IconThemeGetResourcePathMethodInfo
    ResolveIconThemeMethod "getSearchPath" o = IconThemeGetSearchPathMethodInfo
    ResolveIconThemeMethod "getThemeName" o = IconThemeGetThemeNameMethodInfo
    ResolveIconThemeMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveIconThemeMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveIconThemeMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveIconThemeMethod "setResourcePath" o = IconThemeSetResourcePathMethodInfo
    ResolveIconThemeMethod "setSearchPath" o = IconThemeSetSearchPathMethodInfo
    ResolveIconThemeMethod "setThemeName" o = IconThemeSetThemeNameMethodInfo
    ResolveIconThemeMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal IconTheme::changed
-- | Emitted when the current icon theme is switched or GTK+ detects
-- that a change has occurred in the contents of the current
-- icon theme.
type IconThemeChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `IconThemeChangedCallback`@.
noIconThemeChangedCallback :: Maybe IconThemeChangedCallback
noIconThemeChangedCallback :: Maybe (IO ())
noIconThemeChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_IconThemeChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_IconThemeChangedCallback`.
foreign import ccall "wrapper"
    mk_IconThemeChangedCallback :: C_IconThemeChangedCallback -> IO (FunPtr C_IconThemeChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_IconThemeChanged :: MonadIO m => IconThemeChangedCallback -> m (GClosure C_IconThemeChangedCallback)
genClosure_IconThemeChanged :: IO () -> m (GClosure C_IconThemeChangedCallback)
genClosure_IconThemeChanged IO ()
cb = IO (GClosure C_IconThemeChangedCallback)
-> m (GClosure C_IconThemeChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_IconThemeChangedCallback)
 -> m (GClosure C_IconThemeChangedCallback))
-> IO (GClosure C_IconThemeChangedCallback)
-> m (GClosure C_IconThemeChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_IconThemeChangedCallback
cb' = IO () -> C_IconThemeChangedCallback
wrap_IconThemeChangedCallback IO ()
cb
    C_IconThemeChangedCallback
-> IO (FunPtr C_IconThemeChangedCallback)
mk_IconThemeChangedCallback C_IconThemeChangedCallback
cb' IO (FunPtr C_IconThemeChangedCallback)
-> (FunPtr C_IconThemeChangedCallback
    -> IO (GClosure C_IconThemeChangedCallback))
-> IO (GClosure C_IconThemeChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_IconThemeChangedCallback
-> IO (GClosure C_IconThemeChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `IconThemeChangedCallback` into a `C_IconThemeChangedCallback`.
wrap_IconThemeChangedCallback ::
    IconThemeChangedCallback ->
    C_IconThemeChangedCallback
wrap_IconThemeChangedCallback :: IO () -> C_IconThemeChangedCallback
wrap_IconThemeChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' iconTheme #changed callback
-- @
-- 
-- 
onIconThemeChanged :: (IsIconTheme a, MonadIO m) => a -> IconThemeChangedCallback -> m SignalHandlerId
onIconThemeChanged :: a -> IO () -> m SignalHandlerId
onIconThemeChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_IconThemeChangedCallback
cb' = IO () -> C_IconThemeChangedCallback
wrap_IconThemeChangedCallback IO ()
cb
    FunPtr C_IconThemeChangedCallback
cb'' <- C_IconThemeChangedCallback
-> IO (FunPtr C_IconThemeChangedCallback)
mk_IconThemeChangedCallback C_IconThemeChangedCallback
cb'
    a
-> Text
-> FunPtr C_IconThemeChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_IconThemeChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' iconTheme #changed callback
-- @
-- 
-- 
afterIconThemeChanged :: (IsIconTheme a, MonadIO m) => a -> IconThemeChangedCallback -> m SignalHandlerId
afterIconThemeChanged :: a -> IO () -> m SignalHandlerId
afterIconThemeChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_IconThemeChangedCallback
cb' = IO () -> C_IconThemeChangedCallback
wrap_IconThemeChangedCallback IO ()
cb
    FunPtr C_IconThemeChangedCallback
cb'' <- C_IconThemeChangedCallback
-> IO (FunPtr C_IconThemeChangedCallback)
mk_IconThemeChangedCallback C_IconThemeChangedCallback
cb'
    a
-> Text
-> FunPtr C_IconThemeChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_IconThemeChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data IconThemeChangedSignalInfo
instance SignalInfo IconThemeChangedSignalInfo where
    type HaskellCallbackType IconThemeChangedSignalInfo = IconThemeChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_IconThemeChangedCallback cb
        cb'' <- mk_IconThemeChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail

#endif

-- VVV Prop "display"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Display"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@display@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIconThemeDisplay :: (IsIconTheme o, MIO.MonadIO m, Gdk.Display.IsDisplay a) => a -> m (GValueConstruct o)
constructIconThemeDisplay :: a -> m (GValueConstruct o)
constructIconThemeDisplay a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"display" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

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

#if defined(ENABLE_OVERLOADING)
data IconThemeDisplayPropertyInfo
instance AttrInfo IconThemeDisplayPropertyInfo where
    type AttrAllowedOps IconThemeDisplayPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IconThemeDisplayPropertyInfo = IsIconTheme
    type AttrSetTypeConstraint IconThemeDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferTypeConstraint IconThemeDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferType IconThemeDisplayPropertyInfo = Gdk.Display.Display
    type AttrGetType IconThemeDisplayPropertyInfo = (Maybe Gdk.Display.Display)
    type AttrLabel IconThemeDisplayPropertyInfo = "display"
    type AttrOrigin IconThemeDisplayPropertyInfo = IconTheme
    attrGet = getIconThemeDisplay
    attrSet = setIconThemeDisplay
    attrTransfer _ v = do
        unsafeCastTo Gdk.Display.Display v
    attrConstruct = constructIconThemeDisplay
    attrClear = clearIconThemeDisplay
#endif

-- VVV Prop "icon-names"
   -- Type: TCArray True (-1) (-1) (TBasicType TUTF8)
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data IconThemeIconNamesPropertyInfo
instance AttrInfo IconThemeIconNamesPropertyInfo where
    type AttrAllowedOps IconThemeIconNamesPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IconThemeIconNamesPropertyInfo = IsIconTheme
    type AttrSetTypeConstraint IconThemeIconNamesPropertyInfo = (~) ()
    type AttrTransferTypeConstraint IconThemeIconNamesPropertyInfo = (~) ()
    type AttrTransferType IconThemeIconNamesPropertyInfo = ()
    type AttrGetType IconThemeIconNamesPropertyInfo = (Maybe [T.Text])
    type AttrLabel IconThemeIconNamesPropertyInfo = "icon-names"
    type AttrOrigin IconThemeIconNamesPropertyInfo = IconTheme
    attrGet = getIconThemeIconNames
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "resource-path"
   -- Type: TCArray True (-1) (-1) (TBasicType TUTF8)
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@resource-path@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIconThemeResourcePath :: (IsIconTheme o, MIO.MonadIO m) => [T.Text] -> m (GValueConstruct o)
constructIconThemeResourcePath :: [Text] -> m (GValueConstruct o)
constructIconThemeResourcePath [Text]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe [Text] -> IO (GValueConstruct o)
forall o. String -> Maybe [Text] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyStringArray String
"resource-path" ([Text] -> Maybe [Text]
forall a. a -> Maybe a
P.Just [Text]
val)

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

#if defined(ENABLE_OVERLOADING)
data IconThemeResourcePathPropertyInfo
instance AttrInfo IconThemeResourcePathPropertyInfo where
    type AttrAllowedOps IconThemeResourcePathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IconThemeResourcePathPropertyInfo = IsIconTheme
    type AttrSetTypeConstraint IconThemeResourcePathPropertyInfo = (~) [T.Text]
    type AttrTransferTypeConstraint IconThemeResourcePathPropertyInfo = (~) [T.Text]
    type AttrTransferType IconThemeResourcePathPropertyInfo = [T.Text]
    type AttrGetType IconThemeResourcePathPropertyInfo = (Maybe [T.Text])
    type AttrLabel IconThemeResourcePathPropertyInfo = "resource-path"
    type AttrOrigin IconThemeResourcePathPropertyInfo = IconTheme
    attrGet = getIconThemeResourcePath
    attrSet = setIconThemeResourcePath
    attrTransfer _ v = do
        return v
    attrConstruct = constructIconThemeResourcePath
    attrClear = clearIconThemeResourcePath
#endif

-- VVV Prop "search-path"
   -- Type: TCArray True (-1) (-1) (TBasicType TUTF8)
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@search-path@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIconThemeSearchPath :: (IsIconTheme o, MIO.MonadIO m) => [T.Text] -> m (GValueConstruct o)
constructIconThemeSearchPath :: [Text] -> m (GValueConstruct o)
constructIconThemeSearchPath [Text]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe [Text] -> IO (GValueConstruct o)
forall o. String -> Maybe [Text] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyStringArray String
"search-path" ([Text] -> Maybe [Text]
forall a. a -> Maybe a
P.Just [Text]
val)

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

#if defined(ENABLE_OVERLOADING)
data IconThemeSearchPathPropertyInfo
instance AttrInfo IconThemeSearchPathPropertyInfo where
    type AttrAllowedOps IconThemeSearchPathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IconThemeSearchPathPropertyInfo = IsIconTheme
    type AttrSetTypeConstraint IconThemeSearchPathPropertyInfo = (~) [T.Text]
    type AttrTransferTypeConstraint IconThemeSearchPathPropertyInfo = (~) [T.Text]
    type AttrTransferType IconThemeSearchPathPropertyInfo = [T.Text]
    type AttrGetType IconThemeSearchPathPropertyInfo = (Maybe [T.Text])
    type AttrLabel IconThemeSearchPathPropertyInfo = "search-path"
    type AttrOrigin IconThemeSearchPathPropertyInfo = IconTheme
    attrGet = getIconThemeSearchPath
    attrSet = setIconThemeSearchPath
    attrTransfer _ v = do
        return v
    attrConstruct = constructIconThemeSearchPath
    attrClear = clearIconThemeSearchPath
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@theme-name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIconThemeThemeName :: (IsIconTheme o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructIconThemeThemeName :: Text -> m (GValueConstruct o)
constructIconThemeThemeName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"theme-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data IconThemeThemeNamePropertyInfo
instance AttrInfo IconThemeThemeNamePropertyInfo where
    type AttrAllowedOps IconThemeThemeNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IconThemeThemeNamePropertyInfo = IsIconTheme
    type AttrSetTypeConstraint IconThemeThemeNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IconThemeThemeNamePropertyInfo = (~) T.Text
    type AttrTransferType IconThemeThemeNamePropertyInfo = T.Text
    type AttrGetType IconThemeThemeNamePropertyInfo = (Maybe T.Text)
    type AttrLabel IconThemeThemeNamePropertyInfo = "theme-name"
    type AttrOrigin IconThemeThemeNamePropertyInfo = IconTheme
    attrGet = getIconThemeThemeName
    attrSet = setIconThemeThemeName
    attrTransfer _ v = do
        return v
    attrConstruct = constructIconThemeThemeName
    attrClear = clearIconThemeThemeName
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList IconTheme
type instance O.AttributeList IconTheme = IconThemeAttributeList
type IconThemeAttributeList = ('[ '("display", IconThemeDisplayPropertyInfo), '("iconNames", IconThemeIconNamesPropertyInfo), '("resourcePath", IconThemeResourcePathPropertyInfo), '("searchPath", IconThemeSearchPathPropertyInfo), '("themeName", IconThemeThemeNamePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
iconThemeDisplay :: AttrLabelProxy "display"
iconThemeDisplay = AttrLabelProxy

iconThemeIconNames :: AttrLabelProxy "iconNames"
iconThemeIconNames = AttrLabelProxy

iconThemeResourcePath :: AttrLabelProxy "resourcePath"
iconThemeResourcePath = AttrLabelProxy

iconThemeSearchPath :: AttrLabelProxy "searchPath"
iconThemeSearchPath = AttrLabelProxy

iconThemeThemeName :: AttrLabelProxy "themeName"
iconThemeThemeName = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "gtk_icon_theme_new" gtk_icon_theme_new :: 
    IO (Ptr IconTheme)

-- | Creates a new icon theme object. Icon theme objects are used
-- to lookup up an icon by name in a particular icon theme.
-- Usually, you’ll want to use 'GI.Gtk.Objects.IconTheme.iconThemeGetForDisplay'
-- rather than creating a new icon theme object for scratch.
iconThemeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m IconTheme
    -- ^ __Returns:__ the newly created t'GI.Gtk.Objects.IconTheme.IconTheme' object.
iconThemeNew :: m IconTheme
iconThemeNew  = IO IconTheme -> m IconTheme
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconTheme -> m IconTheme) -> IO IconTheme -> m IconTheme
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconTheme
result <- IO (Ptr IconTheme)
gtk_icon_theme_new
    Text -> Ptr IconTheme -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconThemeNew" Ptr IconTheme
result
    IconTheme
result' <- ((ManagedPtr IconTheme -> IconTheme)
-> Ptr IconTheme -> IO IconTheme
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr IconTheme -> IconTheme
IconTheme) Ptr IconTheme
result
    IconTheme -> IO IconTheme
forall (m :: * -> *) a. Monad m => a -> m a
return IconTheme
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method IconTheme::add_resource_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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 = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a resource path" , 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_theme_add_resource_path" gtk_icon_theme_add_resource_path :: 
    Ptr IconTheme ->                        -- self : TInterface (Name {namespace = "Gtk", name = "IconTheme"})
    CString ->                              -- path : TBasicType TUTF8
    IO ()

-- | Adds a resource path that will be looked at when looking
-- for icons, similar to search paths.
-- 
-- See 'GI.Gtk.Objects.IconTheme.iconThemeSetResourcePath'.
-- 
-- This function should be used to make application-specific icons
-- available as part of the icon theme.
iconThemeAddResourcePath ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> T.Text
    -- ^ /@path@/: a resource path
    -> m ()
iconThemeAddResourcePath :: a -> Text -> m ()
iconThemeAddResourcePath a
self Text
path = 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 IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr IconTheme -> CString -> IO ()
gtk_icon_theme_add_resource_path Ptr IconTheme
self' CString
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IconThemeAddResourcePathMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsIconTheme a) => O.MethodInfo IconThemeAddResourcePathMethodInfo a signature where
    overloadedMethod = iconThemeAddResourcePath

#endif

-- method IconTheme::add_search_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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 = "path"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "directory name to append to the icon path"
--                 , 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_theme_add_search_path" gtk_icon_theme_add_search_path :: 
    Ptr IconTheme ->                        -- self : TInterface (Name {namespace = "Gtk", name = "IconTheme"})
    CString ->                              -- path : TBasicType TFileName
    IO ()

-- | Appends a directory to the search path.
-- See 'GI.Gtk.Objects.IconTheme.iconThemeSetSearchPath'.
iconThemeAddSearchPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> [Char]
    -- ^ /@path@/: directory name to append to the icon path
    -> m ()
iconThemeAddSearchPath :: a -> String -> m ()
iconThemeAddSearchPath a
self String
path = 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 IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- String -> IO CString
stringToCString String
path
    Ptr IconTheme -> CString -> IO ()
gtk_icon_theme_add_search_path Ptr IconTheme
self' CString
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IconThemeAddSearchPathMethodInfo
instance (signature ~ ([Char] -> m ()), MonadIO m, IsIconTheme a) => O.MethodInfo IconThemeAddSearchPathMethodInfo a signature where
    overloadedMethod = iconThemeAddSearchPath

#endif

-- method IconTheme::get_icon_names
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

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

-- | Lists the names of icons in the current icon theme.
iconThemeGetIconNames ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> m [T.Text]
    -- ^ __Returns:__ a string array
    --     holding the names of all the icons in the theme. You must
    --     free the array using 'GI.GLib.Functions.strfreev'.
iconThemeGetIconNames :: a -> m [Text]
iconThemeGetIconNames a
self = 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 IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
result <- Ptr IconTheme -> IO (Ptr CString)
gtk_icon_theme_get_icon_names Ptr IconTheme
self'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconThemeGetIconNames" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data IconThemeGetIconNamesMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsIconTheme a) => O.MethodInfo IconThemeGetIconNamesMethodInfo a signature where
    overloadedMethod = iconThemeGetIconNames

#endif

-- method IconTheme::get_icon_sizes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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 = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of an icon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TInt))
-- throws : False
-- Skip return : False

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

-- | Returns an array of integers describing the sizes at which
-- the icon is available without scaling. A size of -1 means
-- that the icon is available in a scalable format. The array
-- is zero-terminated.
iconThemeGetIconSizes ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> T.Text
    -- ^ /@iconName@/: the name of an icon
    -> m [Int32]
    -- ^ __Returns:__ A newly
    -- allocated array describing the sizes at which the icon is
    -- available. The array should be freed with 'GI.GLib.Functions.free' when it is no
    -- longer needed.
iconThemeGetIconSizes :: a -> Text -> m [Int32]
iconThemeGetIconSizes a
self Text
iconName = 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 IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    Ptr Int32
result <- Ptr IconTheme -> CString -> IO (Ptr Int32)
gtk_icon_theme_get_icon_sizes Ptr IconTheme
self' CString
iconName'
    Text -> Ptr Int32 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconThemeGetIconSizes" Ptr Int32
result
    [Int32]
result' <- Ptr Int32 -> IO [Int32]
forall a. (Eq a, Num a, Storable a) => Ptr a -> IO [a]
unpackZeroTerminatedStorableArray Ptr Int32
result
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    [Int32] -> IO [Int32]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int32]
result'

#if defined(ENABLE_OVERLOADING)
data IconThemeGetIconSizesMethodInfo
instance (signature ~ (T.Text -> m [Int32]), MonadIO m, IsIconTheme a) => O.MethodInfo IconThemeGetIconSizesMethodInfo a signature where
    overloadedMethod = iconThemeGetIconSizes

#endif

-- method IconTheme::get_resource_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

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

-- | Gets the current resource path.
-- 
-- See 'GI.Gtk.Objects.IconTheme.iconThemeSetResourcePath'.
iconThemeGetResourcePath ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> m (Maybe [T.Text])
    -- ^ __Returns:__ 
    --   A list of resource paths or 'P.Nothing'.
    --   The returned value should be freed with 'GI.GLib.Functions.strfreev'.
iconThemeGetResourcePath :: a -> m (Maybe [Text])
iconThemeGetResourcePath a
self = IO (Maybe [Text]) -> m (Maybe [Text])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Text]) -> m (Maybe [Text]))
-> IO (Maybe [Text]) -> m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
result <- Ptr IconTheme -> IO (Ptr CString)
gtk_icon_theme_get_resource_path Ptr IconTheme
self'
    Maybe [Text]
maybeResult <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
result' -> do
        [Text]
result'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result'
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
maybeResult

#if defined(ENABLE_OVERLOADING)
data IconThemeGetResourcePathMethodInfo
instance (signature ~ (m (Maybe [T.Text])), MonadIO m, IsIconTheme a) => O.MethodInfo IconThemeGetResourcePathMethodInfo a signature where
    overloadedMethod = iconThemeGetResourcePath

#endif

-- method IconTheme::get_search_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TFileName))
-- throws : False
-- Skip return : False

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

-- | Gets the current search path. See 'GI.Gtk.Objects.IconTheme.iconThemeSetSearchPath'.
iconThemeGetSearchPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> m (Maybe [[Char]])
    -- ^ __Returns:__ 
    --   a list of icon theme path directories or 'P.Nothing'.
    --   The returned value should be freed with 'GI.GLib.Functions.strfreev'.
iconThemeGetSearchPath :: a -> m (Maybe [String])
iconThemeGetSearchPath a
self = IO (Maybe [String]) -> m (Maybe [String])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [String]) -> m (Maybe [String]))
-> IO (Maybe [String]) -> m (Maybe [String])
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
result <- Ptr IconTheme -> IO (Ptr CString)
gtk_icon_theme_get_search_path Ptr IconTheme
self'
    Maybe [String]
maybeResult <- Ptr CString -> (Ptr CString -> IO [String]) -> IO (Maybe [String])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [String]) -> IO (Maybe [String]))
-> (Ptr CString -> IO [String]) -> IO (Maybe [String])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
result' -> do
        [String]
result'' <- HasCallStack => Ptr CString -> IO [String]
Ptr CString -> IO [String]
unpackZeroTerminatedFileNameArray Ptr CString
result'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result'
        [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe [String] -> IO (Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [String]
maybeResult

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

#endif

-- method IconTheme::get_theme_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

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

-- | Gets the current icon theme name.
-- 
-- Returns (transfer full): the current icon theme name,
iconThemeGetThemeName ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> m T.Text
iconThemeGetThemeName :: a -> m Text
iconThemeGetThemeName a
self = 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 IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr IconTheme -> IO CString
gtk_icon_theme_get_theme_name Ptr IconTheme
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconThemeGetThemeName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IconThemeGetThemeNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIconTheme a) => O.MethodInfo IconThemeGetThemeNameMethodInfo a signature where
    overloadedMethod = iconThemeGetThemeName

#endif

-- method IconTheme::has_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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 = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of an icon"
--                 , 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_theme_has_icon" gtk_icon_theme_has_icon :: 
    Ptr IconTheme ->                        -- self : TInterface (Name {namespace = "Gtk", name = "IconTheme"})
    CString ->                              -- icon_name : TBasicType TUTF8
    IO CInt

-- | Checks whether an icon theme includes an icon
-- for a particular name.
iconThemeHasIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> T.Text
    -- ^ /@iconName@/: the name of an icon
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@self@/ includes an
    --  icon for /@iconName@/.
iconThemeHasIcon :: a -> Text -> m Bool
iconThemeHasIcon a
self Text
iconName = 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 IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    CInt
result <- Ptr IconTheme -> CString -> IO CInt
gtk_icon_theme_has_icon Ptr IconTheme
self' CString
iconName'
    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
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IconThemeHasIconMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsIconTheme a) => O.MethodInfo IconThemeHasIconMethodInfo a signature where
    overloadedMethod = iconThemeHasIcon

#endif

-- method IconTheme::lookup_by_gicon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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 = "icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GIcon to look up"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "desired icon size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scale"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the desired scale" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextDirection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "text direction the icon will be displayed in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconLookupFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "flags modifying the behavior of the icon lookup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "IconPaintable" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_icon_theme_lookup_by_gicon" gtk_icon_theme_lookup_by_gicon :: 
    Ptr IconTheme ->                        -- self : TInterface (Name {namespace = "Gtk", name = "IconTheme"})
    Ptr Gio.Icon.Icon ->                    -- icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    Int32 ->                                -- size : TBasicType TInt
    Int32 ->                                -- scale : TBasicType TInt
    CUInt ->                                -- direction : TInterface (Name {namespace = "Gtk", name = "TextDirection"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gtk", name = "IconLookupFlags"})
    IO (Ptr Gtk.IconPaintable.IconPaintable)

-- | Looks up a icon for a desired size and window scale, returning a
-- t'GI.Gtk.Objects.IconPaintable.IconPaintable'. The icon can then be rendered by using it as a t'GI.Gdk.Interfaces.Paintable.Paintable',
-- or you can get information such as the filename and size.
iconThemeLookupByGicon ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a, Gio.Icon.IsIcon b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> b
    -- ^ /@icon@/: the t'GI.Gio.Interfaces.Icon.Icon' to look up
    -> Int32
    -- ^ /@size@/: desired icon size
    -> Int32
    -- ^ /@scale@/: the desired scale
    -> Gtk.Enums.TextDirection
    -- ^ /@direction@/: text direction the icon will be displayed in
    -> [Gtk.Flags.IconLookupFlags]
    -- ^ /@flags@/: flags modifying the behavior of the icon lookup
    -> m Gtk.IconPaintable.IconPaintable
    -- ^ __Returns:__ a t'GI.Gtk.Objects.IconPaintable.IconPaintable' containing
    --     information about the icon. Unref with 'GI.GObject.Objects.Object.objectUnref'
iconThemeLookupByGicon :: a
-> b
-> Int32
-> Int32
-> TextDirection
-> [IconLookupFlags]
-> m IconPaintable
iconThemeLookupByGicon a
self b
icon Int32
size Int32
scale TextDirection
direction [IconLookupFlags]
flags = IO IconPaintable -> m IconPaintable
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconPaintable -> m IconPaintable)
-> IO IconPaintable -> m IconPaintable
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Icon
icon' <- b -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
icon
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TextDirection -> Int) -> TextDirection -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDirection -> Int
forall a. Enum a => a -> Int
fromEnum) TextDirection
direction
    let flags' :: CUInt
flags' = [IconLookupFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [IconLookupFlags]
flags
    Ptr IconPaintable
result <- Ptr IconTheme
-> Ptr Icon
-> Int32
-> Int32
-> CUInt
-> CUInt
-> IO (Ptr IconPaintable)
gtk_icon_theme_lookup_by_gicon Ptr IconTheme
self' Ptr Icon
icon' Int32
size Int32
scale CUInt
direction' CUInt
flags'
    Text -> Ptr IconPaintable -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconThemeLookupByGicon" Ptr IconPaintable
result
    IconPaintable
result' <- ((ManagedPtr IconPaintable -> IconPaintable)
-> Ptr IconPaintable -> IO IconPaintable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr IconPaintable -> IconPaintable
Gtk.IconPaintable.IconPaintable) Ptr IconPaintable
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
icon
    IconPaintable -> IO IconPaintable
forall (m :: * -> *) a. Monad m => a -> m a
return IconPaintable
result'

#if defined(ENABLE_OVERLOADING)
data IconThemeLookupByGiconMethodInfo
instance (signature ~ (b -> Int32 -> Int32 -> Gtk.Enums.TextDirection -> [Gtk.Flags.IconLookupFlags] -> m Gtk.IconPaintable.IconPaintable), MonadIO m, IsIconTheme a, Gio.Icon.IsIcon b) => O.MethodInfo IconThemeLookupByGiconMethodInfo a signature where
    overloadedMethod = iconThemeLookupByGicon

#endif

-- method IconTheme::lookup_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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 = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the icon to lookup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fallbacks"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "desired icon size." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scale"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the window scale this will be displayed on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextDirection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "text direction the icon will be displayed in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconLookupFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "flags modifying the behavior of the icon lookup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "IconPaintable" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_icon_theme_lookup_icon" gtk_icon_theme_lookup_icon :: 
    Ptr IconTheme ->                        -- self : TInterface (Name {namespace = "Gtk", name = "IconTheme"})
    CString ->                              -- icon_name : TBasicType TUTF8
    Ptr CString ->                          -- fallbacks : TCArray True (-1) (-1) (TBasicType TUTF8)
    Int32 ->                                -- size : TBasicType TInt
    Int32 ->                                -- scale : TBasicType TInt
    CUInt ->                                -- direction : TInterface (Name {namespace = "Gtk", name = "TextDirection"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gtk", name = "IconLookupFlags"})
    IO (Ptr Gtk.IconPaintable.IconPaintable)

-- | Looks up a named icon for a desired size and window scale, returning a
-- t'GI.Gtk.Objects.IconPaintable.IconPaintable'. The icon can then be rendered by using it as a t'GI.Gdk.Interfaces.Paintable.Paintable',
-- or you can get information such as the filename and size.
-- 
-- If the available /@iconName@/ is not available and /@fallbacks@/ are provided,
-- they will be tried in order.
-- 
-- If no matching icon is found, then a paintable that renders the
-- \"missing icon\" icon is returned. If you need to do something else
-- for missing icons you need to use 'GI.Gtk.Objects.IconTheme.iconThemeHasIcon'.
-- 
-- Note that you probably want to listen for icon theme changes and
-- update the icon. This is usually done by overriding the
-- t'GI.Gtk.Structs.WidgetClass.WidgetClass'.@/css/@-@/changed()/@ function.
iconThemeLookupIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> T.Text
    -- ^ /@iconName@/: the name of the icon to lookup
    -> Maybe ([T.Text])
    -> Int32
    -- ^ /@size@/: desired icon size.
    -> Int32
    -- ^ /@scale@/: the window scale this will be displayed on
    -> Gtk.Enums.TextDirection
    -- ^ /@direction@/: text direction the icon will be displayed in
    -> [Gtk.Flags.IconLookupFlags]
    -- ^ /@flags@/: flags modifying the behavior of the icon lookup
    -> m Gtk.IconPaintable.IconPaintable
    -- ^ __Returns:__ a t'GI.Gtk.Objects.IconPaintable.IconPaintable' object
    --     containing the icon.
iconThemeLookupIcon :: a
-> Text
-> Maybe [Text]
-> Int32
-> Int32
-> TextDirection
-> [IconLookupFlags]
-> m IconPaintable
iconThemeLookupIcon a
self Text
iconName Maybe [Text]
fallbacks Int32
size Int32
scale TextDirection
direction [IconLookupFlags]
flags = IO IconPaintable -> m IconPaintable
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconPaintable -> m IconPaintable)
-> IO IconPaintable -> m IconPaintable
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    Ptr CString
maybeFallbacks <- case Maybe [Text]
fallbacks of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jFallbacks -> do
            Ptr CString
jFallbacks' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jFallbacks
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jFallbacks'
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TextDirection -> Int) -> TextDirection -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDirection -> Int
forall a. Enum a => a -> Int
fromEnum) TextDirection
direction
    let flags' :: CUInt
flags' = [IconLookupFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [IconLookupFlags]
flags
    Ptr IconPaintable
result <- Ptr IconTheme
-> CString
-> Ptr CString
-> Int32
-> Int32
-> CUInt
-> CUInt
-> IO (Ptr IconPaintable)
gtk_icon_theme_lookup_icon Ptr IconTheme
self' CString
iconName' Ptr CString
maybeFallbacks Int32
size Int32
scale CUInt
direction' CUInt
flags'
    Text -> Ptr IconPaintable -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconThemeLookupIcon" Ptr IconPaintable
result
    IconPaintable
result' <- ((ManagedPtr IconPaintable -> IconPaintable)
-> Ptr IconPaintable -> IO IconPaintable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr IconPaintable -> IconPaintable
Gtk.IconPaintable.IconPaintable) Ptr IconPaintable
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeFallbacks
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeFallbacks
    IconPaintable -> IO IconPaintable
forall (m :: * -> *) a. Monad m => a -> m a
return IconPaintable
result'

#if defined(ENABLE_OVERLOADING)
data IconThemeLookupIconMethodInfo
instance (signature ~ (T.Text -> Maybe ([T.Text]) -> Int32 -> Int32 -> Gtk.Enums.TextDirection -> [Gtk.Flags.IconLookupFlags] -> m Gtk.IconPaintable.IconPaintable), MonadIO m, IsIconTheme a) => O.MethodInfo IconThemeLookupIconMethodInfo a signature where
    overloadedMethod = iconThemeLookupIcon

#endif

-- method IconTheme::set_resource_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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 = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "NULL-terminated array of resource paths\n    that are searched for icons"
--                 , 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_theme_set_resource_path" gtk_icon_theme_set_resource_path :: 
    Ptr IconTheme ->                        -- self : TInterface (Name {namespace = "Gtk", name = "IconTheme"})
    CString ->                              -- path : TBasicType TUTF8
    IO ()

-- | Sets the resource paths that will be looked at when
-- looking for icons, similar to search paths.
-- 
-- The resources are considered as part of the hicolor icon theme
-- and must be located in subdirectories that are defined in the
-- hicolor icon theme, such as @\@path\/16x16\/actions\/run.png@.
-- Icons that are directly placed in the resource path instead
-- of a subdirectory are also considered as ultimate fallback.
iconThemeSetResourcePath ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> T.Text
    -- ^ /@path@/: NULL-terminated array of resource paths
    --     that are searched for icons
    -> m ()
iconThemeSetResourcePath :: a -> Text -> m ()
iconThemeSetResourcePath a
self Text
path = 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 IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr IconTheme -> CString -> IO ()
gtk_icon_theme_set_resource_path Ptr IconTheme
self' CString
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IconThemeSetResourcePathMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsIconTheme a) => O.MethodInfo IconThemeSetResourcePathMethodInfo a signature where
    overloadedMethod = iconThemeSetResourcePath

#endif

-- method IconTheme::set_search_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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 = "path"
--           , argType = TCArray True (-1) (-1) (TBasicType TFileName)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "NULL-terminated\n  array of directories that are searched for icon themes"
--                 , 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_theme_set_search_path" gtk_icon_theme_set_search_path :: 
    Ptr IconTheme ->                        -- self : TInterface (Name {namespace = "Gtk", name = "IconTheme"})
    Ptr CString ->                          -- path : TCArray True (-1) (-1) (TBasicType TFileName)
    IO ()

-- | Sets the search path for the icon theme object. When looking
-- for an icon theme, GTK will search for a subdirectory of
-- one or more of the directories in /@path@/ with the same name
-- as the icon theme containing an index.theme file. (Themes from
-- multiple of the path elements are combined to allow themes to be
-- extended by adding icons in the user’s home directory.)
-- 
-- In addition if an icon found isn’t found either in the current
-- icon theme or the default icon theme, and an image file with
-- the right name is found directly in one of the elements of
-- /@path@/, then that image will be used for the icon name.
-- (This is legacy feature, and new icons should be put
-- into the fallback icon theme, which is called hicolor,
-- rather than directly on the icon path.)
iconThemeSetSearchPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> Maybe ([[Char]])
    -- ^ /@path@/: NULL-terminated
    --   array of directories that are searched for icon themes
    -> m ()
iconThemeSetSearchPath :: a -> Maybe [String] -> m ()
iconThemeSetSearchPath a
self Maybe [String]
path = 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 IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
maybePath <- case Maybe [String]
path of
        Maybe [String]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [String]
jPath -> do
            Ptr CString
jPath' <- [String] -> IO (Ptr CString)
packZeroTerminatedFileNameArray [String]
jPath
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jPath'
    Ptr IconTheme -> Ptr CString -> IO ()
gtk_icon_theme_set_search_path Ptr IconTheme
self' Ptr CString
maybePath
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybePath
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybePath
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IconThemeSetSearchPathMethodInfo
instance (signature ~ (Maybe ([[Char]]) -> m ()), MonadIO m, IsIconTheme a) => O.MethodInfo IconThemeSetSearchPathMethodInfo a signature where
    overloadedMethod = iconThemeSetSearchPath

#endif

-- method IconTheme::set_theme_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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 = "theme_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "name of icon theme to use instead of\n  configured theme, or %NULL to unset a previously set custom theme"
--                 , 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_theme_set_theme_name" gtk_icon_theme_set_theme_name :: 
    Ptr IconTheme ->                        -- self : TInterface (Name {namespace = "Gtk", name = "IconTheme"})
    CString ->                              -- theme_name : TBasicType TUTF8
    IO ()

-- | Sets the name of the icon theme that the t'GI.Gtk.Objects.IconTheme.IconTheme' object uses
-- overriding system configuration. This function cannot be called
-- on the icon theme objects returned from 'GI.Gtk.Objects.IconTheme.iconThemeGetForDisplay'.
iconThemeSetThemeName ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.IconTheme.IconTheme'
    -> Maybe (T.Text)
    -- ^ /@themeName@/: name of icon theme to use instead of
    --   configured theme, or 'P.Nothing' to unset a previously set custom theme
    -> m ()
iconThemeSetThemeName :: a -> Maybe Text -> m ()
iconThemeSetThemeName a
self Maybe Text
themeName = 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 IconTheme
self' <- a -> IO (Ptr IconTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeThemeName <- case Maybe Text
themeName of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jThemeName -> do
            CString
jThemeName' <- Text -> IO CString
textToCString Text
jThemeName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jThemeName'
    Ptr IconTheme -> CString -> IO ()
gtk_icon_theme_set_theme_name Ptr IconTheme
self' CString
maybeThemeName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeThemeName
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

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

foreign import ccall "gtk_icon_theme_get_for_display" gtk_icon_theme_get_for_display :: 
    Ptr Gdk.Display.Display ->              -- display : TInterface (Name {namespace = "Gdk", name = "Display"})
    IO (Ptr IconTheme)

-- | Gets the icon theme object associated with /@display@/; if this
-- function has not previously been called for the given
-- display, a new icon theme object will be created and
-- associated with the display. Icon theme objects are
-- fairly expensive to create, so using this function
-- is usually a better choice than calling than 'GI.Gtk.Objects.IconTheme.iconThemeNew'
-- and setting the display yourself; by using this function
-- a single icon theme object will be shared between users.
iconThemeGetForDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Display.IsDisplay a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m IconTheme
    -- ^ __Returns:__ A unique t'GI.Gtk.Objects.IconTheme.IconTheme' associated with
    --  the given display. This icon theme is associated with
    --  the display and can be used as long as the display
    --  is open. Do not ref or unref it.
iconThemeGetForDisplay :: a -> m IconTheme
iconThemeGetForDisplay a
display = IO IconTheme -> m IconTheme
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconTheme -> m IconTheme) -> IO IconTheme -> m IconTheme
forall a b. (a -> b) -> a -> b
$ do
    Ptr Display
display' <- a -> IO (Ptr Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr IconTheme
result <- Ptr Display -> IO (Ptr IconTheme)
gtk_icon_theme_get_for_display Ptr Display
display'
    Text -> Ptr IconTheme -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconThemeGetForDisplay" Ptr IconTheme
result
    IconTheme
result' <- ((ManagedPtr IconTheme -> IconTheme)
-> Ptr IconTheme -> IO IconTheme
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr IconTheme -> IconTheme
IconTheme) Ptr IconTheme
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    IconTheme -> IO IconTheme
forall (m :: * -> *) a. Monad m => a -> m a
return IconTheme
result'

#if defined(ENABLE_OVERLOADING)
#endif