{-# LINE 2 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget IconTheme
--
-- Author : Andy Stewart
--
-- Created: 28 Mar 2010
--
-- Copyright (C) 2010 Andy Stewart
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Looking up icons by name
--
-- * Module available since Gtk+ version 2.4
--
module Graphics.UI.Gtk.General.IconTheme (

-- * Detail
--
-- | '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
-- Icon Theme Specification. There is a default icon theme, named hicolor where applications should
-- install their icons, but more additional application themes can be installed as operating system
-- vendors and users choose.
--
-- Named icons are similar to the Themeable Stock Images facility, and the distinction between the
-- two may be a bit confusing. A few things to keep in mind:
--
-- * Stock images usually are used in conjunction with Stock Items, such as ''StockOk'' or
-- ''StockOpen''. Named icons are easier to set up and therefore are more useful for new icons
-- that an application wants to add, such as application icons or window icons.
--
-- * Stock images can only be loaded at the symbolic sizes defined by the 'IconSize' enumeration, or
-- by custom sizes defined by 'iconSizeRegister', while named icons are more flexible and any
-- pixel size can be specified.
--
-- * Because stock images are closely tied to stock items, and thus to actions in the user interface,
-- stock images may come in multiple variants for different widget states or writing directions.
--
-- A good rule of thumb is that if there is a stock image for what you want to use, use it, otherwise
-- use a named icon. It turns out that internally stock images are generally defined in terms of one or
-- more named icons. (An example of the more than one case is icons that depend on writing direction;
-- ''StockGoForward'' uses the two themed icons 'gtkStockGoForwardLtr' and
-- 'gtkStockGoForwardRtl'.)
--
-- In many cases, named themes are used indirectly, via 'Image' or stock items, rather than directly,
-- but looking up icons directly is also simple. The 'IconTheme' object acts as a database of all the
-- icons in the current theme. You can create new 'IconTheme' objects, but its much more efficient to
-- use the standard icon theme for the 'Screen' so that the icon information is shared with other
-- people looking up icons. In the case where the default screen is being used, looking up an icon can
-- be as simple as:

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----IconTheme
-- @


-- * Types
  IconTheme,
  IconThemeClass,
  castToIconTheme,
  toIconTheme,

  IconInfo,

-- * Enums
  IconLookupFlags(..),
  IconThemeError(..),

-- * Constructors
  iconThemeNew,


  iconInfoNewForPixbuf,


-- * Methods
  iconThemeGetDefault,
  iconThemeGetForScreen,
  iconThemeSetScreen,
  iconThemeSetSearchPath,
  iconThemeGetSearchPath,
  iconThemeAppendSearchPath,
  iconThemePrependSearchPath,
  iconThemeSetCustomTheme,
  iconThemeHasIcon,
  iconThemeLookupIcon,

  iconThemeChooseIcon,


  iconThemeLookupByGIcon,



  iconThemeLoadIcon,

  iconThemeListContexts,

  iconThemeListIcons,

  iconThemeGetIconSizes,

  iconThemeGetExampleIconName,
  iconThemeRescanIfNeeded,
  iconThemeAddBuiltinIcon,
  iconThemeErrorQuark,

  iconInfoCopy,
  iconInfoGetAttachPoints,
  iconInfoGetBaseSize,
  iconInfoGetBuiltinPixbuf,
  iconInfoGetDisplayName,
  iconInfoGetEmbeddedRect,
  iconInfoGetFilename,
  iconInfoLoadIcon,
  iconInfoSetRawCoordinates,

-- * Signals
  iconThemeChanged,

  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.GError (propagateGError)
import Graphics.UI.Gtk.General.Structs (Rectangle, Point)
import Graphics.UI.Gtk.Types
{-# LINE 150 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 151 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}

import System.GIO.Types
{-# LINE 153 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}



{-# LINE 156 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}


--------------------
-- Enums
data IconLookupFlags = IconLookupNoSvg
                     | IconLookupForceSvg
                     | IconLookupUseBuiltin
                     | IconLookupGenericFallback
                     | IconLookupForceSize
                     deriving (IconLookupFlags
IconLookupFlags -> IconLookupFlags -> Bounded IconLookupFlags
forall a. a -> a -> Bounded a
$cminBound :: IconLookupFlags
minBound :: IconLookupFlags
$cmaxBound :: IconLookupFlags
maxBound :: IconLookupFlags
Bounded,IconLookupFlags -> IconLookupFlags -> Bool
(IconLookupFlags -> IconLookupFlags -> Bool)
-> (IconLookupFlags -> IconLookupFlags -> Bool)
-> Eq IconLookupFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IconLookupFlags -> IconLookupFlags -> Bool
== :: IconLookupFlags -> IconLookupFlags -> Bool
$c/= :: IconLookupFlags -> IconLookupFlags -> Bool
/= :: IconLookupFlags -> IconLookupFlags -> Bool
Eq,Int -> IconLookupFlags -> ShowS
[IconLookupFlags] -> ShowS
IconLookupFlags -> String
(Int -> IconLookupFlags -> ShowS)
-> (IconLookupFlags -> String)
-> ([IconLookupFlags] -> ShowS)
-> Show IconLookupFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IconLookupFlags -> ShowS
showsPrec :: Int -> IconLookupFlags -> ShowS
$cshow :: IconLookupFlags -> String
show :: IconLookupFlags -> String
$cshowList :: [IconLookupFlags] -> ShowS
showList :: [IconLookupFlags] -> ShowS
Show)
instance Enum IconLookupFlags where
  fromEnum IconLookupNoSvg = 1
  fromEnum IconLookupForceSvg = 2
  fromEnum IconLookupUseBuiltin = 4
  fromEnum IconLookupGenericFallback = 8
  fromEnum IconLookupForceSize = 16

  toEnum 1 = IconLookupNoSvg
  toEnum 2 = IconLookupForceSvg
  toEnum 4 = IconLookupUseBuiltin
  toEnum 8 = IconLookupGenericFallback
  toEnum 16 = IconLookupForceSize
  toEnum unmatched = error ("IconLookupFlags.toEnum: Cannot match " ++ show unmatched)

  succ IconLookupNoSvg = IconLookupForceSvg
  succ IconLookupForceSvg = IconLookupUseBuiltin
  succ IconLookupUseBuiltin = IconLookupGenericFallback
  succ IconLookupGenericFallback = IconLookupForceSize
  succ _ = undefined

  pred IconLookupForceSvg = IconLookupNoSvg
  pred IconLookupUseBuiltin = IconLookupForceSvg
  pred IconLookupGenericFallback = IconLookupUseBuiltin
  pred IconLookupForceSize = IconLookupGenericFallback
  pred _ = undefined

  enumFromTo :: IconLookupFlags -> IconLookupFlags -> [IconLookupFlags]
enumFromTo IconLookupFlags
x IconLookupFlags
y | IconLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum IconLookupFlags
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== IconLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum IconLookupFlags
y = [ IconLookupFlags
y ]
                 | Bool
otherwise = IconLookupFlags
x IconLookupFlags -> [IconLookupFlags] -> [IconLookupFlags]
forall a. a -> [a] -> [a]
: IconLookupFlags -> IconLookupFlags -> [IconLookupFlags]
forall a. Enum a => a -> a -> [a]
enumFromTo (IconLookupFlags -> IconLookupFlags
forall a. Enum a => a -> a
succ IconLookupFlags
x) IconLookupFlags
y
  enumFrom :: IconLookupFlags -> [IconLookupFlags]
enumFrom IconLookupFlags
x = IconLookupFlags -> IconLookupFlags -> [IconLookupFlags]
forall a. Enum a => a -> a -> [a]
enumFromTo IconLookupFlags
x IconLookupFlags
IconLookupForceSize
  enumFromThen :: IconLookupFlags -> IconLookupFlags -> [IconLookupFlags]
enumFromThen IconLookupFlags
_ IconLookupFlags
_ =     String -> [IconLookupFlags]
forall a. HasCallStack => String -> a
error String
"Enum IconLookupFlags: enumFromThen not implemented"
  enumFromThenTo :: IconLookupFlags
-> IconLookupFlags -> IconLookupFlags -> [IconLookupFlags]
enumFromThenTo IconLookupFlags
_ IconLookupFlags
_ IconLookupFlags
_ =     String -> [IconLookupFlags]
forall a. HasCallStack => String -> a
error String
"Enum IconLookupFlags: enumFromThenTo not implemented"

{-# LINE 161 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}

data IconThemeError = IconThemeNotFound
                    | IconThemeFailed
                    deriving (Enum,Bounded,Eq,Show)

{-# LINE 163 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}

--------------------
-- Constructors

-- | 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
-- 'iconThemeGetDefault' or 'iconThemeGetForScreen' rather than creating a new
-- icon theme object for scratch.
--
iconThemeNew :: IO IconTheme
iconThemeNew =
  wrapNewGObject mkIconTheme $
  gtk_icon_theme_new
{-# LINE 176 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}

--------------------
-- Methods

-- | Gets the icon theme for the default screen. See 'iconThemeGetForScreen'.
--
iconThemeGetDefault ::
    IO IconTheme -- ^ returns A unique 'IconTheme' associated with the default
                 -- screen. This icon theme is associated with the screen and
                 -- can be used as long as the screen is open.
iconThemeGetDefault =
  makeNewGObject mkIconTheme $
  gtk_icon_theme_get_default
{-# LINE 189 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}

-- | Gets the icon theme object associated with @screen@; if this function has
-- not previously been called for the given screen, a new icon theme object
-- will be created and associated with the screen. Icon theme objects are
-- fairly expensive to create, so using this function is usually a better
-- choice than calling than 'iconThemeNew' and setting the screen yourself; by
-- using this function a single icon theme object will be shared between users.
--
iconThemeGetForScreen ::
    Screen -- ^ @screen@ - a 'Screen'
 -> IO IconTheme -- ^ returns A unique 'IconTheme' associated with the given
                 -- screen.
iconThemeGetForScreen :: Screen -> IO IconTheme
iconThemeGetForScreen Screen
screen =
  (ForeignPtr IconTheme -> IconTheme, FinalizerPtr IconTheme)
-> IO (Ptr IconTheme) -> IO IconTheme
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr IconTheme -> IconTheme, FinalizerPtr IconTheme)
forall {a}. (ForeignPtr IconTheme -> IconTheme, FinalizerPtr a)
mkIconTheme (IO (Ptr IconTheme) -> IO IconTheme)
-> IO (Ptr IconTheme) -> IO IconTheme
forall a b. (a -> b) -> a -> b
$
  (\(Screen ForeignPtr Screen
arg1) -> ForeignPtr Screen
-> (Ptr Screen -> IO (Ptr IconTheme)) -> IO (Ptr IconTheme)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Screen
arg1 ((Ptr Screen -> IO (Ptr IconTheme)) -> IO (Ptr IconTheme))
-> (Ptr Screen -> IO (Ptr IconTheme)) -> IO (Ptr IconTheme)
forall a b. (a -> b) -> a -> b
$ \Ptr Screen
argPtr1 ->Ptr Screen -> IO (Ptr IconTheme)
gtk_icon_theme_get_for_screen Ptr Screen
argPtr1)
{-# LINE 204 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    screen

-- | Sets the screen for an icon theme; the screen is used to track the user's
-- currently configured icon theme, which might be different for different
-- screens.
--
iconThemeSetScreen :: IconThemeClass self => self
 -> Screen -- ^ @screen@ - a 'Screen'
 -> IO ()
iconThemeSetScreen :: forall self. IconThemeClass self => self -> Screen -> IO ()
iconThemeSetScreen self
self Screen
screen =
  (\(IconTheme ForeignPtr IconTheme
arg1) (Screen ForeignPtr Screen
arg2) -> ForeignPtr IconTheme -> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO ()) -> IO ())
-> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->ForeignPtr Screen -> (Ptr Screen -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Screen
arg2 ((Ptr Screen -> IO ()) -> IO ()) -> (Ptr Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Screen
argPtr2 ->Ptr IconTheme -> Ptr Screen -> IO ()
gtk_icon_theme_set_screen Ptr IconTheme
argPtr1 Ptr Screen
argPtr2)
{-# LINE 215 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    (toIconTheme self)
    Screen
screen

-- | 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. (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
-- default icon theme, which is called DEFAULT_THEME_NAME, rather than directly
-- on the icon path.)
--
iconThemeSetSearchPath :: (IconThemeClass self, GlibFilePath fp) => self
 -> [fp] -- ^ @path@ - list of directories that are searched for icon
           -- themes
 -> Int -- ^ @nElements@ - number of elements in @path@.
 -> IO ()
iconThemeSetSearchPath :: forall self fp.
(IconThemeClass self, GlibFilePath fp) =>
self -> [fp] -> Int -> IO ()
iconThemeSetSearchPath self
self [fp]
path Int
nElements =
  [fp] -> (Ptr CString -> IO ()) -> IO ()
forall fp a.
GlibFilePath fp =>
[fp] -> (Ptr CString -> IO a) -> IO a
withUTFFilePathArray [fp]
path ((Ptr CString -> IO ()) -> IO ())
-> (Ptr CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CString
pathPtr ->
  (\(IconTheme ForeignPtr IconTheme
arg1) Ptr CString
arg2 CInt
arg3 -> ForeignPtr IconTheme -> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO ()) -> IO ())
-> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> Ptr CString -> CInt -> IO ()
gtk_icon_theme_set_search_path Ptr IconTheme
argPtr1 Ptr CString
arg2 CInt
arg3)
{-# LINE 239 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    (toIconTheme self)
    Ptr CString
pathPtr
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nElements)

-- | Gets the current search path. See 'iconThemeSetSearchPath'.
--
iconThemeGetSearchPath :: (IconThemeClass self, GlibFilePath fp) => self
 -> IO ([fp], Int) -- ^ @(path, nElements)@
                                -- @path@ - location to store a list of icon theme path
                                -- directories.
iconThemeGetSearchPath :: forall self fp.
(IconThemeClass self, GlibFilePath fp) =>
self -> IO ([fp], Int)
iconThemeGetSearchPath self
self =
  (Ptr CInt -> IO ([fp], Int)) -> IO ([fp], Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO ([fp], Int)) -> IO ([fp], Int))
-> (Ptr CInt -> IO ([fp], Int)) -> IO ([fp], Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
nElementsPtr ->
  Int -> (Ptr CString -> IO ([fp], Int)) -> IO ([fp], Int)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
0 ((Ptr CString -> IO ([fp], Int)) -> IO ([fp], Int))
-> (Ptr CString -> IO ([fp], Int)) -> IO ([fp], Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
pathPtr -> do
  (\(IconTheme ForeignPtr IconTheme
arg1) Ptr (Ptr CString)
arg2 Ptr CInt
arg3 -> ForeignPtr IconTheme -> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO ()) -> IO ())
-> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> Ptr (Ptr CString) -> Ptr CInt -> IO ()
gtk_icon_theme_get_search_path Ptr IconTheme
argPtr1 Ptr (Ptr CString)
arg2 Ptr CInt
arg3)
{-# LINE 253 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    (toIconTheme self)
    (Ptr CString -> Ptr (Ptr CString)
forall a b. Ptr a -> Ptr b
castPtr Ptr CString
pathPtr)
    Ptr CInt
nElementsPtr
  [fp]
pathStr <- Ptr CString -> IO [fp]
forall fp. GlibFilePath fp => Ptr CString -> IO [fp]
readUTFFilePathArray0 Ptr CString
pathPtr
  CInt
nElements <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
nElementsPtr
  ([fp], Int) -> IO ([fp], Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([fp]
pathStr, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nElements)

-- | Appends a directory to the search path. See 'iconThemeSetSearchPath'.
--
iconThemeAppendSearchPath :: (IconThemeClass self, GlibFilePath fp) => self
 -> fp -- ^ @path@ - directory name to append to the icon path
 -> IO ()
iconThemeAppendSearchPath :: forall self fp.
(IconThemeClass self, GlibFilePath fp) =>
self -> fp -> IO ()
iconThemeAppendSearchPath self
self fp
path =
  fp -> (CString -> IO ()) -> IO ()
forall a. fp -> (CString -> IO a) -> IO a
forall fp a. GlibFilePath fp => fp -> (CString -> IO a) -> IO a
withUTFFilePath fp
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
pathPtr ->
  (\(IconTheme ForeignPtr IconTheme
arg1) CString
arg2 -> ForeignPtr IconTheme -> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO ()) -> IO ())
-> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> CString -> IO ()
gtk_icon_theme_append_search_path Ptr IconTheme
argPtr1 CString
arg2)
{-# LINE 268 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    (toIconTheme self)
    CString
pathPtr

-- | Prepends a directory to the search path. See 'iconThemeSetSearchPath'.
--
iconThemePrependSearchPath :: (IconThemeClass self, GlibFilePath fp) => self
 -> fp -- ^ @path@ - directory name to prepend to the icon path
 -> IO ()
iconThemePrependSearchPath :: forall self fp.
(IconThemeClass self, GlibFilePath fp) =>
self -> fp -> IO ()
iconThemePrependSearchPath self
self fp
path =
  fp -> (CString -> IO ()) -> IO ()
forall a. fp -> (CString -> IO a) -> IO a
forall fp a. GlibFilePath fp => fp -> (CString -> IO a) -> IO a
withUTFFilePath fp
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
pathPtr ->
  (\(IconTheme ForeignPtr IconTheme
arg1) CString
arg2 -> ForeignPtr IconTheme -> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO ()) -> IO ())
-> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> CString -> IO ()
gtk_icon_theme_prepend_search_path Ptr IconTheme
argPtr1 CString
arg2)
{-# LINE 279 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    (toIconTheme self)
    CString
pathPtr

-- | Sets the name of the icon theme that the 'IconTheme' object uses
-- overriding system configuration. This function cannot be called on the icon
-- theme objects returned from 'iconThemeGetDefault' and
-- 'iconThemeGetForScreen'.
--
iconThemeSetCustomTheme :: (IconThemeClass self, GlibString string) => self
 -> (Maybe string) -- ^ @themeName@ name of icon theme to use instead of configured theme, or 'Nothing' to unset a previously set custom theme
 -> IO ()
iconThemeSetCustomTheme :: forall self string.
(IconThemeClass self, GlibString string) =>
self -> Maybe string -> IO ()
iconThemeSetCustomTheme self
self Maybe string
themeName =
  (string -> (CString -> IO ()) -> IO ())
-> Maybe string -> (CString -> IO ()) -> IO ()
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString Maybe string
themeName ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
themeNamePtr ->
  (\(IconTheme ForeignPtr IconTheme
arg1) CString
arg2 -> ForeignPtr IconTheme -> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO ()) -> IO ())
-> (Ptr IconTheme -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> CString -> IO ()
gtk_icon_theme_set_custom_theme Ptr IconTheme
argPtr1 CString
arg2)
{-# LINE 293 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    (toIconTheme self)
    CString
themeNamePtr

-- | Checks whether an icon theme includes an icon for a particular name.
--
iconThemeHasIcon :: (IconThemeClass self, GlibString string) => self
 -> string -- ^ @iconName@ - the name of an icon
 -> IO Bool -- ^ returns @True@ if @iconTheme@ includes an icon for
            -- @iconName@.
iconThemeHasIcon :: forall self string.
(IconThemeClass self, GlibString string) =>
self -> string -> IO Bool
iconThemeHasIcon self
self string
iconName =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  string -> (CString -> IO CInt) -> IO CInt
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
iconName ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
iconNamePtr ->
  (\(IconTheme ForeignPtr IconTheme
arg1) CString
arg2 -> ForeignPtr IconTheme -> (Ptr IconTheme -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO CInt) -> IO CInt)
-> (Ptr IconTheme -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> CString -> IO CInt
gtk_icon_theme_has_icon Ptr IconTheme
argPtr1 CString
arg2)
{-# LINE 306 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    (toIconTheme self)
    CString
iconNamePtr

-- | Looks up a named icon and returns a structure containing information such
-- as the filename of the icon. The icon can then be rendered into a pixbuf
-- using 'iconInfoLoadIcon'. ('iconThemeLoadIcon' combines these two steps if
-- all you need is the pixbuf.)
--
iconThemeLookupIcon :: (IconThemeClass self, GlibString string) => self
 -> string -- ^ @iconName@ - the name of the icon to lookup
 -> Int -- ^ @size@ - desired icon size
 -> IconLookupFlags -- ^ @flags@ - flags modifying the behavior of the
                        -- icon lookup
 -> IO (Maybe IconInfo) -- ^ returns a 'IconInfo'
                        -- structure containing information about the icon, or
                         -- 'Nothing' if the icon wasn't found.
iconThemeLookupIcon :: forall self string.
(IconThemeClass self, GlibString string) =>
self -> string -> Int -> IconLookupFlags -> IO (Maybe IconInfo)
iconThemeLookupIcon self
self string
iconName Int
size IconLookupFlags
flags =
  string -> (CString -> IO (Maybe IconInfo)) -> IO (Maybe IconInfo)
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
iconName ((CString -> IO (Maybe IconInfo)) -> IO (Maybe IconInfo))
-> (CString -> IO (Maybe IconInfo)) -> IO (Maybe IconInfo)
forall a b. (a -> b) -> a -> b
$ \CString
iconNamePtr -> do
  Ptr ()
iiPtr <- (\(IconTheme ForeignPtr IconTheme
arg1) CString
arg2 CInt
arg3 CInt
arg4 -> ForeignPtr IconTheme
-> (Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> CString -> CInt -> CInt -> IO (Ptr ())
gtk_icon_theme_lookup_icon Ptr IconTheme
argPtr1 CString
arg2 CInt
arg3 CInt
arg4)
{-# LINE 325 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
          (self -> IconTheme
forall o. IconThemeClass o => o -> IconTheme
toIconTheme self
self)
          CString
iconNamePtr
          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
          ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (IconLookupFlags -> Int) -> IconLookupFlags -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum) IconLookupFlags
flags)
  if Ptr ()
iiPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr
     then Maybe IconInfo -> IO (Maybe IconInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IconInfo
forall a. Maybe a
Nothing
     else (IconInfo -> Maybe IconInfo) -> IO IconInfo -> IO (Maybe IconInfo)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IconInfo -> Maybe IconInfo
forall a. a -> Maybe a
Just (Ptr IconInfo -> IO IconInfo
mkIconInfo (Ptr () -> Ptr IconInfo
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
iiPtr))


-- | Looks up a named icon and returns a structure containing information such
-- as the filename of the icon. The icon can then be rendered into a pixbuf
-- using 'iconInfoLoadIcon'. ('iconThemeLoadIcon' combines these two steps if
-- all you need is the pixbuf.)
--
-- If @iconNames@ contains more than one name, this function tries them all
-- in the given order before falling back to inherited icon themes.
--
-- * Available since Gtk+ version 2.12
--
iconThemeChooseIcon :: (IconThemeClass self, GlibString string) => self
 -> [string] -- ^ @iconNames@ terminated list of icon names to lookup
 -> Int -- ^ @size@ - desired icon size
 -> IconLookupFlags -- ^ @flags@ - flags modifying the behavior of the
                        -- icon lookup
 -> IO (Maybe IconInfo) -- ^ returns a 'IconInfo'
                        -- structure containing information about the icon, or
                         -- 'Nothing' if the icon wasn't found.
iconThemeChooseIcon :: forall self string.
(IconThemeClass self, GlibString string) =>
self -> [string] -> Int -> IconLookupFlags -> IO (Maybe IconInfo)
iconThemeChooseIcon self
self [string]
iconNames Int
size IconLookupFlags
flags =
  [string]
-> (Ptr CString -> IO (Maybe IconInfo)) -> IO (Maybe IconInfo)
forall s a. GlibString s => [s] -> (Ptr CString -> IO a) -> IO a
withUTFStringArray0 [string]
iconNames ((Ptr CString -> IO (Maybe IconInfo)) -> IO (Maybe IconInfo))
-> (Ptr CString -> IO (Maybe IconInfo)) -> IO (Maybe IconInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
iconNamesPtr -> do
  Ptr ()
iiPtr <- (\(IconTheme ForeignPtr IconTheme
arg1) Ptr CString
arg2 CInt
arg3 CInt
arg4 -> ForeignPtr IconTheme
-> (Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> Ptr CString -> CInt -> CInt -> IO (Ptr ())
gtk_icon_theme_choose_icon Ptr IconTheme
argPtr1 Ptr CString
arg2 CInt
arg3 CInt
arg4)
{-# LINE 355 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
          (self -> IconTheme
forall o. IconThemeClass o => o -> IconTheme
toIconTheme self
self)
          Ptr CString
iconNamesPtr
          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
          ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (IconLookupFlags -> Int) -> IconLookupFlags -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum) IconLookupFlags
flags)
  if Ptr ()
iiPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr
     then Maybe IconInfo -> IO (Maybe IconInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IconInfo
forall a. Maybe a
Nothing
     else (IconInfo -> Maybe IconInfo) -> IO IconInfo -> IO (Maybe IconInfo)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IconInfo -> Maybe IconInfo
forall a. a -> Maybe a
Just (Ptr IconInfo -> IO IconInfo
mkIconInfo (Ptr () -> Ptr IconInfo
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
iiPtr))



-- | Looks up an icon and returns a structure containing information such as
-- the filename of the icon. The icon can then be rendered into a pixbuf using
-- 'iconInfoLoadIcon'.
--
-- * Available since Gtk+ version 2.14
--
iconThemeLookupByGIcon :: (IconThemeClass self, IconClass icon) => self
 -> icon -- ^ @icon@ - the 'Icon' to look up
 -> Int -- ^ @size@ - desired icon size
 -> IconLookupFlags -- ^ @flags@ - flags modifying the behavior of the
                        -- icon lookup
 -> IO (Maybe IconInfo) -- ^ returns a 'IconInfo'
                        -- structure containing information about the icon, or
                        -- 'Nothing' if the icon wasn't found.
iconThemeLookupByGIcon :: forall self icon.
(IconThemeClass self, IconClass icon) =>
self -> icon -> Int -> IconLookupFlags -> IO (Maybe IconInfo)
iconThemeLookupByGIcon self
self icon
icon Int
size IconLookupFlags
flags = do
    Ptr ()
iiPtr <- (\(IconTheme ForeignPtr IconTheme
arg1) (Icon ForeignPtr Icon
arg2) CInt
arg3 CInt
arg4 -> ForeignPtr IconTheme
-> (Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->ForeignPtr Icon -> (Ptr Icon -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Icon
arg2 ((Ptr Icon -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr Icon -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr Icon
argPtr2 ->Ptr IconTheme -> Ptr Icon -> CInt -> CInt -> IO (Ptr ())
gtk_icon_theme_lookup_by_gicon Ptr IconTheme
argPtr1 Ptr Icon
argPtr2 CInt
arg3 CInt
arg4)
{-# LINE 381 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
            (self -> IconTheme
forall o. IconThemeClass o => o -> IconTheme
toIconTheme self
self)
            (icon -> Icon
forall o. IconClass o => o -> Icon
toIcon icon
icon)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
            ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (IconLookupFlags -> Int) -> IconLookupFlags -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum) IconLookupFlags
flags)
    if Ptr ()
iiPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr
       then Maybe IconInfo -> IO (Maybe IconInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IconInfo
forall a. Maybe a
Nothing
       else (IconInfo -> Maybe IconInfo) -> IO IconInfo -> IO (Maybe IconInfo)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IconInfo -> Maybe IconInfo
forall a. a -> Maybe a
Just (Ptr IconInfo -> IO IconInfo
mkIconInfo (Ptr () -> Ptr IconInfo
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
iiPtr))




-- | Looks up an icon in an icon theme, scales it to the given size and
-- renders it into a pixbuf. This is a convenience function; if more details
-- about the icon are needed, use 'iconThemeLookupIcon' followed by
-- 'iconInfoLoadIcon'.
--
-- Note that you probably want to listen for icon theme changes and update
-- the icon. This is usually done by connecting to the 'Widget'::style-set
-- signal. If for some reason you do not want to update the icon when the icon
-- theme changes, you should consider using 'pixbufCopy' to make a private copy
-- of the pixbuf returned by this function. Otherwise Gtk+ may need to keep the
-- old icon theme loaded, which would be a waste of memory.
--
iconThemeLoadIcon :: (IconThemeClass self, GlibString string) => self
 -> string -- ^ @iconName@ - the name of the icon to lookup
 -> Int -- ^ @size@ - the desired icon size. The resulting icon
                      -- may not be exactly this size; see 'iconInfoLoadIcon'.
 -> IconLookupFlags -- ^ @flags@ - flags modifying the behavior of the icon
                      -- lookup
 -> IO (Maybe Pixbuf) -- ^ returns the rendered icon; this may be a newly
                      -- created icon or a new reference to an internal icon,
                      -- so you must not modify the icon.
                      -- `Nothing` if the icon isn't found.
iconThemeLoadIcon :: forall self string.
(IconThemeClass self, GlibString string) =>
self -> string -> Int -> IconLookupFlags -> IO (Maybe Pixbuf)
iconThemeLoadIcon self
self string
iconName Int
size IconLookupFlags
flags =
  (IO (Ptr Pixbuf) -> IO Pixbuf)
-> IO (Ptr Pixbuf) -> IO (Maybe Pixbuf)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf) (IO (Ptr Pixbuf) -> IO (Maybe Pixbuf))
-> IO (Ptr Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$
  (Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errorPtr ->
  string -> (CString -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
iconName ((CString -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (CString -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \CString
iconNamePtr ->
  (\(IconTheme ForeignPtr IconTheme
arg1) CString
arg2 CInt
arg3 CInt
arg4 Ptr (Ptr ())
arg5 -> ForeignPtr IconTheme
-> (Ptr IconTheme -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr IconTheme -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme
-> CString -> CInt -> CInt -> Ptr (Ptr ()) -> IO (Ptr Pixbuf)
gtk_icon_theme_load_icon Ptr IconTheme
argPtr1 CString
arg2 CInt
arg3 CInt
arg4 Ptr (Ptr ())
arg5)
{-# LINE 419 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    (toIconTheme self)
    CString
iconNamePtr
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (IconLookupFlags -> Int) -> IconLookupFlags -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum) IconLookupFlags
flags)
    Ptr (Ptr ())
errorPtr


-- | Gets the list of contexts available within the current hierarchy of icon
-- themes
--
-- * Available since Gtk+ version 2.12
--
iconThemeListContexts :: (IconThemeClass self, GlibString string) => self
 -> IO [string] -- ^ returns a String list
                            -- holding the names of all the contexts in the
                            -- theme.
iconThemeListContexts :: forall self string.
(IconThemeClass self, GlibString string) =>
self -> IO [string]
iconThemeListContexts self
self = do
  Ptr ()
glistPtr <- (\(IconTheme ForeignPtr IconTheme
arg1) -> ForeignPtr IconTheme
-> (Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> IO (Ptr ())
gtk_icon_theme_list_contexts Ptr IconTheme
argPtr1) (self -> IconTheme
forall o. IconThemeClass o => o -> IconTheme
toIconTheme self
self)
  [CString]
list <- Ptr () -> IO [CString]
forall a. Ptr () -> IO [Ptr a]
fromGList Ptr ()
glistPtr
  [string]
result <- (CString -> IO string) -> [CString] -> IO [string]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CString -> IO string
forall s. GlibString s => CString -> IO s
readUTFString [CString]
list
  Ptr () -> IO ()
g_list_free (Ptr () -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
glistPtr)
  [string] -> IO [string]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [string]
result


-- | Lists the icons in the current icon theme. Only a subset of the icons can
-- be listed by providing a context string. The set of values for the context
-- string is system dependent, but will typically include such values as
-- \"Applications\" and \"MimeTypes\".
--
iconThemeListIcons :: (IconThemeClass self, GlibString string) => self
 -> (Maybe string) -- ^ @context@ a string identifying a particular type of icon, or 'Nothing' to list all icons.
 -> IO [string] -- ^ returns a String list
               -- holding the names of all the icons in the theme.
iconThemeListIcons :: forall self string.
(IconThemeClass self, GlibString string) =>
self -> Maybe string -> IO [string]
iconThemeListIcons self
self Maybe string
context =
  (string -> (CString -> IO [string]) -> IO [string])
-> Maybe string -> (CString -> IO [string]) -> IO [string]
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith string -> (CString -> IO [string]) -> IO [string]
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString Maybe string
context ((CString -> IO [string]) -> IO [string])
-> (CString -> IO [string]) -> IO [string]
forall a b. (a -> b) -> a -> b
$ \CString
contextPtr -> do
  Ptr ()
glistPtr <- (\(IconTheme ForeignPtr IconTheme
arg1) CString
arg2 -> ForeignPtr IconTheme
-> (Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr IconTheme -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> CString -> IO (Ptr ())
gtk_icon_theme_list_icons Ptr IconTheme
argPtr1 CString
arg2)
{-# LINE 455 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
             (self -> IconTheme
forall o. IconThemeClass o => o -> IconTheme
toIconTheme self
self)
             CString
contextPtr
  [CString]
list <- Ptr () -> IO [CString]
forall a. Ptr () -> IO [Ptr a]
fromGList Ptr ()
glistPtr
  [string]
result <- (CString -> IO string) -> [CString] -> IO [string]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CString -> IO string
forall s. GlibString s => CString -> IO s
readUTFString [CString]
list
  Ptr () -> IO ()
g_list_free (Ptr () -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
glistPtr)
  [string] -> IO [string]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [string]
result


-- | Returns an list 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 list is zero-terminated.
--
-- * Available since Gtk+ version 2.6
--
iconThemeGetIconSizes :: (IconThemeClass self, GlibString string) => self
 -> string -- ^ @iconName@ - the name of an icon
 -> IO [Int] -- ^ returns An newly allocated list describing the sizes at
            -- which the icon is available.
iconThemeGetIconSizes :: forall self string.
(IconThemeClass self, GlibString string) =>
self -> string -> IO [Int]
iconThemeGetIconSizes self
self string
iconName =
  string -> (CString -> IO [Int]) -> IO [Int]
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
iconName ((CString -> IO [Int]) -> IO [Int])
-> (CString -> IO [Int]) -> IO [Int]
forall a b. (a -> b) -> a -> b
$ \CString
iconNamePtr -> do
  Ptr CInt
listPtr <- (\(IconTheme ForeignPtr IconTheme
arg1) CString
arg2 -> ForeignPtr IconTheme
-> (Ptr IconTheme -> IO (Ptr CInt)) -> IO (Ptr CInt)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO (Ptr CInt)) -> IO (Ptr CInt))
-> (Ptr IconTheme -> IO (Ptr CInt)) -> IO (Ptr CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> CString -> IO (Ptr CInt)
gtk_icon_theme_get_icon_sizes Ptr IconTheme
argPtr1 CString
arg2)
{-# LINE 476 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
              (self -> IconTheme
forall o. IconThemeClass o => o -> IconTheme
toIconTheme self
self)
              CString
iconNamePtr
  [CInt]
list <- Int -> Ptr CInt -> IO [CInt]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
0 Ptr CInt
listPtr
  Ptr () -> IO ()
g_free (Ptr CInt -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
listPtr)
  [Int] -> IO [Int]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CInt -> Int) -> [CInt] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [CInt]
list)


-- | Gets the name of an icon that is representative of the current theme (for
-- instance, to use when presenting a list of themes to the user.)
--
iconThemeGetExampleIconName :: (IconThemeClass self, GlibString string) => self
 -> IO (Maybe string) -- ^ returns the name of an example icon or `Nothing'
iconThemeGetExampleIconName :: forall self string.
(IconThemeClass self, GlibString string) =>
self -> IO (Maybe string)
iconThemeGetExampleIconName self
self = do
  CString
namePtr <- (\(IconTheme ForeignPtr IconTheme
arg1) -> ForeignPtr IconTheme -> (Ptr IconTheme -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO CString) -> IO CString)
-> (Ptr IconTheme -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> IO CString
gtk_icon_theme_get_example_icon_name Ptr IconTheme
argPtr1) (self -> IconTheme
forall o. IconThemeClass o => o -> IconTheme
toIconTheme self
self)
  if CString
namePtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
     then Maybe string -> IO (Maybe string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe string
forall a. Maybe a
Nothing
     else (string -> Maybe string) -> IO string -> IO (Maybe string)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM string -> Maybe string
forall a. a -> Maybe a
Just (IO string -> IO (Maybe string)) -> IO string -> IO (Maybe string)
forall a b. (a -> b) -> a -> b
$ CString -> IO string
forall s. GlibString s => CString -> IO s
readUTFString CString
namePtr

-- | Checks to see if the icon theme has changed; if it has, any currently
-- cached information is discarded and will be reloaded next time @iconTheme@
-- is accessed.
--
iconThemeRescanIfNeeded :: IconThemeClass self => self
 -> IO Bool -- ^ returns @True@ if the icon theme has changed and needed to be
            -- reloaded.
iconThemeRescanIfNeeded :: forall self. IconThemeClass self => self -> IO Bool
iconThemeRescanIfNeeded self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(IconTheme ForeignPtr IconTheme
arg1) -> ForeignPtr IconTheme -> (Ptr IconTheme -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO CInt) -> IO CInt)
-> (Ptr IconTheme -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->Ptr IconTheme -> IO CInt
gtk_icon_theme_rescan_if_needed Ptr IconTheme
argPtr1)
{-# LINE 504 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    (toIconTheme self)

-- | Registers a built-in icon for icon theme lookups. The idea of built-in
-- icons is to allow an application or library that uses themed icons to
-- function requiring files to be present in the file system. For instance, the
-- default images for all of Gtk+'s stock icons are registered as built-icons.
--
-- In general, if you use 'iconThemeAddBuiltinIcon' you should also install
-- the icon in the icon theme, so that the icon is generally available.
--
-- This function will generally be used with pixbufs loaded via
-- 'pixbufNewFromInline'.
--
iconThemeAddBuiltinIcon :: GlibString string =>
    string -- ^ @iconName@ - the name of the icon to register
 -> Int -- ^ @size@ - the size at which to register the icon (different
           -- images can be registered for the same icon name at different
           -- sizes.)
 -> Pixbuf -- ^ @pixbuf@ - 'Pixbuf' that contains the image to use for
           -- @iconName@.
 -> IO ()
iconThemeAddBuiltinIcon :: forall string.
GlibString string =>
string -> Int -> Pixbuf -> IO ()
iconThemeAddBuiltinIcon string
iconName Int
size Pixbuf
pixbuf =
  string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
iconName ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
iconNamePtr ->
  (\CString
arg1 CInt
arg2 (Pixbuf ForeignPtr Pixbuf
arg3) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg3 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr3 ->CString -> CInt -> Ptr Pixbuf -> IO ()
gtk_icon_theme_add_builtin_icon CString
arg1 CInt
arg2 Ptr Pixbuf
argPtr3)
{-# LINE 528 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    iconNamePtr
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
    Pixbuf
pixbuf

-- |
--
iconThemeErrorQuark :: IO Quark
iconThemeErrorQuark :: IO Quark
iconThemeErrorQuark =
  IO Quark
gtk_icon_theme_error_quark
{-# LINE 537 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}

--------------------
-- Types
newtype IconInfo = IconInfo (ForeignPtr (IconInfo))
{-# LINE 541 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}

foreign import ccall unsafe "&gtk_icon_info_free"
  icon_info_free :: FinalizerPtr IconInfo

-- | Helper function for build 'IconInfo'
mkIconInfo :: Ptr IconInfo -> IO IconInfo
mkIconInfo :: Ptr IconInfo -> IO IconInfo
mkIconInfo Ptr IconInfo
infoPtr =
  (ForeignPtr IconInfo -> IconInfo)
-> IO (ForeignPtr IconInfo) -> IO IconInfo
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ForeignPtr IconInfo -> IconInfo
IconInfo (IO (ForeignPtr IconInfo) -> IO IconInfo)
-> IO (ForeignPtr IconInfo) -> IO IconInfo
forall a b. (a -> b) -> a -> b
$ Ptr IconInfo -> FinalizerPtr IconInfo -> IO (ForeignPtr IconInfo)
forall a. Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
newForeignPtr Ptr IconInfo
infoPtr FinalizerPtr IconInfo
icon_info_free

--------------------
-- Constructors


-- |
--
iconInfoNewForPixbuf :: IconThemeClass iconTheme => iconTheme -> Pixbuf -> IO IconInfo
iconInfoNewForPixbuf :: forall iconTheme.
IconThemeClass iconTheme =>
iconTheme -> Pixbuf -> IO IconInfo
iconInfoNewForPixbuf iconTheme
iconTheme Pixbuf
pixbuf =
  (\(IconTheme ForeignPtr IconTheme
arg1) (Pixbuf ForeignPtr Pixbuf
arg2) -> ForeignPtr IconTheme
-> (Ptr IconTheme -> IO (Ptr IconInfo)) -> IO (Ptr IconInfo)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconTheme
arg1 ((Ptr IconTheme -> IO (Ptr IconInfo)) -> IO (Ptr IconInfo))
-> (Ptr IconTheme -> IO (Ptr IconInfo)) -> IO (Ptr IconInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr IconTheme
argPtr1 ->ForeignPtr Pixbuf
-> (Ptr Pixbuf -> IO (Ptr IconInfo)) -> IO (Ptr IconInfo)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg2 ((Ptr Pixbuf -> IO (Ptr IconInfo)) -> IO (Ptr IconInfo))
-> (Ptr Pixbuf -> IO (Ptr IconInfo)) -> IO (Ptr IconInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr2 ->Ptr IconTheme -> Ptr Pixbuf -> IO (Ptr IconInfo)
gtk_icon_info_new_for_pixbuf Ptr IconTheme
argPtr1 Ptr Pixbuf
argPtr2)
{-# LINE 559 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
          (iconTheme -> IconTheme
forall o. IconThemeClass o => o -> IconTheme
toIconTheme iconTheme
iconTheme)
          Pixbuf
pixbuf
  IO (Ptr IconInfo) -> (Ptr IconInfo -> IO IconInfo) -> IO IconInfo
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr IconInfo -> IO IconInfo
mkIconInfo


--------------------
-- Methods

-- |
--
iconInfoCopy :: IconInfo -> IO IconInfo
iconInfoCopy :: IconInfo -> IO IconInfo
iconInfoCopy IconInfo
self =
  (\(IconInfo ForeignPtr IconInfo
arg1) -> ForeignPtr IconInfo
-> (Ptr IconInfo -> IO (Ptr IconInfo)) -> IO (Ptr IconInfo)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconInfo
arg1 ((Ptr IconInfo -> IO (Ptr IconInfo)) -> IO (Ptr IconInfo))
-> (Ptr IconInfo -> IO (Ptr IconInfo)) -> IO (Ptr IconInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr IconInfo
argPtr1 ->Ptr IconInfo -> IO (Ptr IconInfo)
gtk_icon_info_copy Ptr IconInfo
argPtr1) IconInfo
self
  IO (Ptr IconInfo) -> (Ptr IconInfo -> IO IconInfo) -> IO IconInfo
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr IconInfo -> IO IconInfo
mkIconInfo

-- | Fetches the set of attach points for an icon. An attach point is a location in the icon that can be
-- used as anchor points for attaching emblems or overlays to the icon.
iconInfoGetAttachPoints :: IconInfo -> IO (Maybe [Point])
iconInfoGetAttachPoints :: IconInfo -> IO (Maybe [Point])
iconInfoGetAttachPoints IconInfo
self =
  (Ptr (Ptr Point) -> IO (Maybe [Point])) -> IO (Maybe [Point])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr Point) -> IO (Maybe [Point])) -> IO (Maybe [Point]))
-> (Ptr (Ptr Point) -> IO (Maybe [Point])) -> IO (Maybe [Point])
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Point)
arrPtrPtr ->
  (Ptr CInt -> IO (Maybe [Point])) -> IO (Maybe [Point])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe [Point])) -> IO (Maybe [Point]))
-> (Ptr CInt -> IO (Maybe [Point])) -> IO (Maybe [Point])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
nPointsPtr -> do
  Bool
success <- (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
            (\(IconInfo ForeignPtr IconInfo
arg1) Ptr (Ptr ())
arg2 Ptr CInt
arg3 -> ForeignPtr IconInfo -> (Ptr IconInfo -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconInfo
arg1 ((Ptr IconInfo -> IO CInt) -> IO CInt)
-> (Ptr IconInfo -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr IconInfo
argPtr1 ->Ptr IconInfo -> Ptr (Ptr ()) -> Ptr CInt -> IO CInt
gtk_icon_info_get_attach_points Ptr IconInfo
argPtr1 Ptr (Ptr ())
arg2 Ptr CInt
arg3)
{-# LINE 582 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
              IconInfo
self
              (Ptr (Ptr Point) -> Ptr (Ptr ())
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr Point)
arrPtrPtr)
              Ptr CInt
nPointsPtr
  if Bool
success
     then do
       Ptr Point
arrPtr <- Ptr (Ptr Point) -> IO (Ptr Point)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Point)
arrPtrPtr
       CInt
nPoints <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
nPointsPtr
       [Point]
pointList <- Int -> Ptr Point -> IO [Point]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nPoints) Ptr Point
arrPtr
       Ptr () -> IO ()
g_free (Ptr Point -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Point
arrPtr)
       Maybe [Point] -> IO (Maybe [Point])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Point] -> IO (Maybe [Point]))
-> Maybe [Point] -> IO (Maybe [Point])
forall a b. (a -> b) -> a -> b
$ [Point] -> Maybe [Point]
forall a. a -> Maybe a
Just [Point]
pointList
     else Maybe [Point] -> IO (Maybe [Point])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Point]
forall a. Maybe a
Nothing

-- | Gets the base size for the icon. The base size is a size for the icon that was specified by the icon
-- theme creator. This may be different than the actual size of image; an example of this is small
-- emblem icons that can be attached to a larger icon. These icons will be given the same base size as
-- the larger icons to which they are attached.
--
iconInfoGetBaseSize :: IconInfo -> IO Int
iconInfoGetBaseSize :: IconInfo -> IO Int
iconInfoGetBaseSize IconInfo
self =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(IconInfo ForeignPtr IconInfo
arg1) -> ForeignPtr IconInfo -> (Ptr IconInfo -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconInfo
arg1 ((Ptr IconInfo -> IO CInt) -> IO CInt)
-> (Ptr IconInfo -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr IconInfo
argPtr1 ->Ptr IconInfo -> IO CInt
gtk_icon_info_get_base_size Ptr IconInfo
argPtr1) IconInfo
self

-- | Gets the built-in image for this icon, if any. To allow GTK+ to use built in icon images, you must
-- pass the ''IconLookupUseBuiltin'' to 'iconThemeLookupIcon'.
iconInfoGetBuiltinPixbuf :: IconInfo
 -> IO (Maybe Pixbuf) -- ^ returns the built-in image pixbuf, or 'Nothing'.
iconInfoGetBuiltinPixbuf :: IconInfo -> IO (Maybe Pixbuf)
iconInfoGetBuiltinPixbuf IconInfo
self = do
  Ptr Pixbuf
pixbufPtr <- (\(IconInfo ForeignPtr IconInfo
arg1) -> ForeignPtr IconInfo
-> (Ptr IconInfo -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconInfo
arg1 ((Ptr IconInfo -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr IconInfo -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr IconInfo
argPtr1 ->Ptr IconInfo -> IO (Ptr Pixbuf)
gtk_icon_info_get_builtin_pixbuf Ptr IconInfo
argPtr1) IconInfo
self
  if Ptr Pixbuf
pixbufPtr Ptr Pixbuf -> Ptr Pixbuf -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Pixbuf
forall a. Ptr a
nullPtr
     then Maybe Pixbuf -> IO (Maybe Pixbuf)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
forall a. Maybe a
Nothing
     else (Pixbuf -> Maybe Pixbuf) -> IO Pixbuf -> IO (Maybe Pixbuf)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Pixbuf -> Maybe Pixbuf
forall a. a -> Maybe a
Just (IO Pixbuf -> IO (Maybe Pixbuf)) -> IO Pixbuf -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (Ptr Pixbuf -> IO (Ptr Pixbuf)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
pixbufPtr)

-- | Gets the display name for an icon. A display name is a string to be used in place of the icon name
-- in a user visible context like a list of icons.
iconInfoGetDisplayName :: GlibString string => IconInfo
 -> IO (Maybe string) -- ^ returns the display name for the icon or 'Nothing', if the icon doesn't have a specified display name.
iconInfoGetDisplayName :: forall string. GlibString string => IconInfo -> IO (Maybe string)
iconInfoGetDisplayName IconInfo
self = do
  CString
strPtr <- (\(IconInfo ForeignPtr IconInfo
arg1) -> ForeignPtr IconInfo -> (Ptr IconInfo -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconInfo
arg1 ((Ptr IconInfo -> IO CString) -> IO CString)
-> (Ptr IconInfo -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr IconInfo
argPtr1 ->Ptr IconInfo -> IO CString
gtk_icon_info_get_display_name Ptr IconInfo
argPtr1) IconInfo
self
  if CString
strPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
     then Maybe string -> IO (Maybe string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe string
forall a. Maybe a
Nothing
     else (string -> Maybe string) -> IO string -> IO (Maybe string)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM string -> Maybe string
forall a. a -> Maybe a
Just (IO string -> IO (Maybe string)) -> IO string -> IO (Maybe string)
forall a b. (a -> b) -> a -> b
$ CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString CString
strPtr

-- | Gets the coordinates of a rectangle within the icon that can be used for display of information such
-- as a preview of the contents of a text file. See 'iconInfoSetRawCoordinates' for further
-- information about the coordinate system.
iconInfoGetEmbeddedRect :: IconInfo
 -> IO (Maybe Rectangle) -- ^ @rectangle@ 'Rectangle' in which to store embedded
                         -- rectangle coordinates.
iconInfoGetEmbeddedRect :: IconInfo -> IO (Maybe Rectangle)
iconInfoGetEmbeddedRect IconInfo
self =
  (Ptr Rectangle -> IO (Maybe Rectangle)) -> IO (Maybe Rectangle)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Rectangle -> IO (Maybe Rectangle)) -> IO (Maybe Rectangle))
-> (Ptr Rectangle -> IO (Maybe Rectangle)) -> IO (Maybe Rectangle)
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
rectPtr -> do
  Bool
success <- (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
            (\(IconInfo ForeignPtr IconInfo
arg1) Ptr ()
arg2 -> ForeignPtr IconInfo -> (Ptr IconInfo -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconInfo
arg1 ((Ptr IconInfo -> IO CInt) -> IO CInt)
-> (Ptr IconInfo -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr IconInfo
argPtr1 ->Ptr IconInfo -> Ptr () -> IO CInt
gtk_icon_info_get_embedded_rect Ptr IconInfo
argPtr1 Ptr ()
arg2)
{-# LINE 634 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
            IconInfo
self
            (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
rectPtr)
  if Bool
success
     then (Rectangle -> Maybe Rectangle)
-> IO Rectangle -> IO (Maybe Rectangle)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Rectangle -> Maybe Rectangle
forall a. a -> Maybe a
Just (IO Rectangle -> IO (Maybe Rectangle))
-> IO Rectangle -> IO (Maybe Rectangle)
forall a b. (a -> b) -> a -> b
$ Ptr Rectangle -> IO Rectangle
forall a. Storable a => Ptr a -> IO a
peek Ptr Rectangle
rectPtr
     else Maybe Rectangle -> IO (Maybe Rectangle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Rectangle
forall a. Maybe a
Nothing

-- | Gets the filename for the icon. If the ''IconLookupUseBuiltin'' flag was passed to
-- 'iconThemeLookupIcon', there may be no filename if a builtin icon is returned; in this case,
-- you should use 'iconInfoGetBuiltinPixbuf'.
iconInfoGetFilename :: GlibString string => IconInfo
 -> IO (Maybe string) -- ^ returns the filename for the icon,
                     -- or 'Nothing' if 'iconInfoGetBuiltinPixbuf' should be used instead.
iconInfoGetFilename :: forall string. GlibString string => IconInfo -> IO (Maybe string)
iconInfoGetFilename IconInfo
self = do
  CString
namePtr <- (\(IconInfo ForeignPtr IconInfo
arg1) -> ForeignPtr IconInfo -> (Ptr IconInfo -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconInfo
arg1 ((Ptr IconInfo -> IO CString) -> IO CString)
-> (Ptr IconInfo -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr IconInfo
argPtr1 ->Ptr IconInfo -> IO CString
gtk_icon_info_get_filename Ptr IconInfo
argPtr1) IconInfo
self
  if CString
namePtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
     then Maybe string -> IO (Maybe string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe string
forall a. Maybe a
Nothing
     else (string -> Maybe string) -> IO string -> IO (Maybe string)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM string -> Maybe string
forall a. a -> Maybe a
Just (IO string -> IO (Maybe string)) -> IO string -> IO (Maybe string)
forall a b. (a -> b) -> a -> b
$ CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString CString
namePtr

-- | Looks up an icon in an icon theme, scales it to the given size and renders it into a pixbuf. This is
-- a convenience function; if more details about the icon are needed, use 'iconThemeLookupIcon'
-- followed by 'iconInfoLoadIcon'.
--
-- Note that you probably want to listen for icon theme changes and update the icon. This is usually
-- done by connecting to the 'styleSet' signal. If for some reason you do not want to update
-- the icon when the icon theme changes, you should consider using 'pixbufCopy' to make a private
-- copy of the pixbuf returned by this function. Otherwise GTK+ may need to keep the old icon theme
-- loaded, which would be a waste of memory.
iconInfoLoadIcon :: IconInfo -> IO Pixbuf
iconInfoLoadIcon :: IconInfo -> IO Pixbuf
iconInfoLoadIcon IconInfo
self =
  (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
  (Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errorPtr ->
  (\(IconInfo ForeignPtr IconInfo
arg1) Ptr (Ptr ())
arg2 -> ForeignPtr IconInfo
-> (Ptr IconInfo -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconInfo
arg1 ((Ptr IconInfo -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr IconInfo -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr IconInfo
argPtr1 ->Ptr IconInfo -> Ptr (Ptr ()) -> IO (Ptr Pixbuf)
gtk_icon_info_load_icon Ptr IconInfo
argPtr1 Ptr (Ptr ())
arg2)
{-# LINE 666 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    self
    Ptr (Ptr ())
errorPtr

-- | Sets whether the coordinates returned by 'iconInfoGetEmbeddedRect' and
-- 'iconInfoGetAttachPoints' should be returned in their original form as specified in the icon
-- theme, instead of scaled appropriately for the pixbuf returned by 'iconInfoLoadIcon'.
--
-- Raw coordinates are somewhat strange; they are specified to be with respect to the unscaled pixmap
-- for PNG and XPM icons, but for SVG icons, they are in a 1000x1000 coordinate space that is scaled to
-- the final size of the icon. You can determine if the icon is an SVG icon by using
-- 'iconInfoGetFilename', and seeing if it is non-'Nothing' and ends in '.svg'.
--
-- This function is provided primarily to allow compatibility wrappers for older API's, and is not
-- expected to be useful for applications.
iconInfoSetRawCoordinates :: IconInfo
 -> Bool -- ^ @rawCoordinates@ whether the coordinates of
         -- embedded rectangles and attached points should be returned in their original
 -> IO ()
iconInfoSetRawCoordinates :: IconInfo -> Bool -> IO ()
iconInfoSetRawCoordinates IconInfo
self Bool
rawCoordinates =
  (\(IconInfo ForeignPtr IconInfo
arg1) CInt
arg2 -> ForeignPtr IconInfo -> (Ptr IconInfo -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IconInfo
arg1 ((Ptr IconInfo -> IO ()) -> IO ())
-> (Ptr IconInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IconInfo
argPtr1 ->Ptr IconInfo -> CInt -> IO ()
gtk_icon_info_set_raw_coordinates Ptr IconInfo
argPtr1 CInt
arg2)
{-# LINE 686 "./Graphics/UI/Gtk/General/IconTheme.chs" #-}
    self
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
rawCoordinates)

--------------------
-- Signals

-- | Emitted when the current icon theme is switched or Gtk+ detects that a
-- change has occurred in the contents of the current icon theme.
--
iconThemeChanged :: IconThemeClass self => Signal self (IO ())
iconThemeChanged :: forall self. IconThemeClass self => Signal self (IO ())
iconThemeChanged = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"changed")

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

foreign import ccall safe "gtk_icon_theme_get_default"
  gtk_icon_theme_get_default :: (IO (Ptr IconTheme))

foreign import ccall safe "gtk_icon_theme_get_for_screen"
  gtk_icon_theme_get_for_screen :: ((Ptr Screen) -> (IO (Ptr IconTheme)))

foreign import ccall safe "gtk_icon_theme_set_screen"
  gtk_icon_theme_set_screen :: ((Ptr IconTheme) -> ((Ptr Screen) -> (IO ())))

foreign import ccall safe "gtk_icon_theme_set_search_path"
  gtk_icon_theme_set_search_path :: ((Ptr IconTheme) -> ((Ptr (Ptr CChar)) -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_icon_theme_get_search_path"
  gtk_icon_theme_get_search_path :: ((Ptr IconTheme) -> ((Ptr (Ptr (Ptr CChar))) -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "gtk_icon_theme_append_search_path"
  gtk_icon_theme_append_search_path :: ((Ptr IconTheme) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "gtk_icon_theme_prepend_search_path"
  gtk_icon_theme_prepend_search_path :: ((Ptr IconTheme) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "gtk_icon_theme_set_custom_theme"
  gtk_icon_theme_set_custom_theme :: ((Ptr IconTheme) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "gtk_icon_theme_has_icon"
  gtk_icon_theme_has_icon :: ((Ptr IconTheme) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall safe "gtk_icon_theme_lookup_icon"
  gtk_icon_theme_lookup_icon :: ((Ptr IconTheme) -> ((Ptr CChar) -> (CInt -> (CInt -> (IO (Ptr ()))))))

foreign import ccall safe "gtk_icon_theme_choose_icon"
  gtk_icon_theme_choose_icon :: ((Ptr IconTheme) -> ((Ptr (Ptr CChar)) -> (CInt -> (CInt -> (IO (Ptr ()))))))

foreign import ccall safe "gtk_icon_theme_lookup_by_gicon"
  gtk_icon_theme_lookup_by_gicon :: ((Ptr IconTheme) -> ((Ptr Icon) -> (CInt -> (CInt -> (IO (Ptr ()))))))

foreign import ccall safe "gtk_icon_theme_load_icon"
  gtk_icon_theme_load_icon :: ((Ptr IconTheme) -> ((Ptr CChar) -> (CInt -> (CInt -> ((Ptr (Ptr ())) -> (IO (Ptr Pixbuf)))))))

foreign import ccall safe "gtk_icon_theme_list_contexts"
  gtk_icon_theme_list_contexts :: ((Ptr IconTheme) -> (IO (Ptr ())))

foreign import ccall unsafe "g_list_free"
  g_list_free :: ((Ptr ()) -> (IO ()))

foreign import ccall safe "gtk_icon_theme_list_icons"
  gtk_icon_theme_list_icons :: ((Ptr IconTheme) -> ((Ptr CChar) -> (IO (Ptr ()))))

foreign import ccall safe "gtk_icon_theme_get_icon_sizes"
  gtk_icon_theme_get_icon_sizes :: ((Ptr IconTheme) -> ((Ptr CChar) -> (IO (Ptr CInt))))

foreign import ccall unsafe "g_free"
  g_free :: ((Ptr ()) -> (IO ()))

foreign import ccall safe "gtk_icon_theme_get_example_icon_name"
  gtk_icon_theme_get_example_icon_name :: ((Ptr IconTheme) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_icon_theme_rescan_if_needed"
  gtk_icon_theme_rescan_if_needed :: ((Ptr IconTheme) -> (IO CInt))

foreign import ccall safe "gtk_icon_theme_add_builtin_icon"
  gtk_icon_theme_add_builtin_icon :: ((Ptr CChar) -> (CInt -> ((Ptr Pixbuf) -> (IO ()))))

foreign import ccall safe "gtk_icon_theme_error_quark"
  gtk_icon_theme_error_quark :: (IO CUInt)

foreign import ccall safe "gtk_icon_info_new_for_pixbuf"
  gtk_icon_info_new_for_pixbuf :: ((Ptr IconTheme) -> ((Ptr Pixbuf) -> (IO (Ptr IconInfo))))

foreign import ccall safe "gtk_icon_info_copy"
  gtk_icon_info_copy :: ((Ptr IconInfo) -> (IO (Ptr IconInfo)))

foreign import ccall safe "gtk_icon_info_get_attach_points"
  gtk_icon_info_get_attach_points :: ((Ptr IconInfo) -> ((Ptr (Ptr ())) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "gtk_icon_info_get_base_size"
  gtk_icon_info_get_base_size :: ((Ptr IconInfo) -> (IO CInt))

foreign import ccall safe "gtk_icon_info_get_builtin_pixbuf"
  gtk_icon_info_get_builtin_pixbuf :: ((Ptr IconInfo) -> (IO (Ptr Pixbuf)))

foreign import ccall safe "gtk_icon_info_get_display_name"
  gtk_icon_info_get_display_name :: ((Ptr IconInfo) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_icon_info_get_embedded_rect"
  gtk_icon_info_get_embedded_rect :: ((Ptr IconInfo) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "gtk_icon_info_get_filename"
  gtk_icon_info_get_filename :: ((Ptr IconInfo) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_icon_info_load_icon"
  gtk_icon_info_load_icon :: ((Ptr IconInfo) -> ((Ptr (Ptr ())) -> (IO (Ptr Pixbuf))))

foreign import ccall safe "gtk_icon_info_set_raw_coordinates"
  gtk_icon_info_set_raw_coordinates :: ((Ptr IconInfo) -> (CInt -> (IO ())))