{-# LINE 2 "./System/GIO/Icons/ThemedIcon.chs" #-}
-- GIMP Toolkit (GTK) Binding for Haskell: binding to gio -*-haskell-*-
--
-- Author : Andy Stewart
-- Created: 30-Apirl-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 3 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.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http:
--
-- GIO, the C library which this Haskell library depends on, is
-- available under LGPL Version 2. The documentation included with
-- this library is based on the original GIO documentation.
--
-- | Maintainer : gtk2hs-devel@lists.sourceforge.net
-- Stability : alpha
-- Portability : portable (depends on GHC)
module System.GIO.Icons.ThemedIcon (
-- * Details
--
-- | 'ThemeIcon' specifies an icon by pointing to an image file to be used as icon.

-- * Types
    ThemedIcon(..),
    ThemedIconClass,

-- * Methods
    themedIconNew,
    themedIconNewFromNames,

    themedIconPrependName,

    themedIconAppendName,
    themedIconGetNames,
    ) where

import Control.Monad
import Data.ByteString (ByteString)
import Data.ByteString (useAsCString)
import Data.ByteString.Unsafe (unsafePackCStringFinalizer)
import System.GIO.Enums
import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GError
import System.Glib.GObject
import System.Glib.UTFString
import System.GIO.Types
{-# LINE 60 "./System/GIO/Icons/ThemedIcon.chs" #-}


{-# LINE 62 "./System/GIO/Icons/ThemedIcon.chs" #-}

-------------------
-- Methods
-- | Creates a new icon for a file.
themedIconNew :: ByteString -- ^ @iconname@ a string containing an icon name.
 -> IO ThemedIcon
themedIconNew :: ByteString -> IO ThemedIcon
themedIconNew ByteString
iconName =
  ByteString -> (CString -> IO ThemedIcon) -> IO ThemedIcon
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
iconName ((CString -> IO ThemedIcon) -> IO ThemedIcon)
-> (CString -> IO ThemedIcon) -> IO ThemedIcon
forall a b. (a -> b) -> a -> b
$ \ CString
iconNamePtr ->
  CString -> IO (Ptr Icon)
g_themed_icon_new CString
iconNamePtr
  IO (Ptr Icon) -> (Ptr Icon -> IO ThemedIcon) -> IO ThemedIcon
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((ForeignPtr ThemedIcon -> ThemedIcon, FinalizerPtr ThemedIcon)
-> IO (Ptr ThemedIcon) -> IO ThemedIcon
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr ThemedIcon -> ThemedIcon, FinalizerPtr ThemedIcon)
forall {a}. (ForeignPtr ThemedIcon -> ThemedIcon, FinalizerPtr a)
mkThemedIcon (IO (Ptr ThemedIcon) -> IO ThemedIcon)
-> (Ptr ThemedIcon -> IO (Ptr ThemedIcon))
-> Ptr ThemedIcon
-> IO ThemedIcon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ThemedIcon -> IO (Ptr ThemedIcon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) (Ptr ThemedIcon -> IO ThemedIcon)
-> (Ptr Icon -> Ptr ThemedIcon) -> Ptr Icon -> IO ThemedIcon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Icon -> Ptr ThemedIcon
forall a b. Ptr a -> Ptr b
castPtr

-- | Creates a new themed icon for iconnames.
themedIconNewFromNames :: GlibString string
 => [string] -- ^ @iconnames@ an array of strings containing icon names.
 -> IO ThemedIcon
themedIconNewFromNames :: forall string. GlibString string => [string] -> IO ThemedIcon
themedIconNewFromNames [string]
iconNames = do
  let len :: Int
len = if [string] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [string]
iconNames then (-Int
1) else [string] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [string]
iconNames
  [string] -> (Ptr CString -> IO ThemedIcon) -> IO ThemedIcon
forall s a. GlibString s => [s] -> (Ptr CString -> IO a) -> IO a
withUTFStringArray [string]
iconNames ((Ptr CString -> IO ThemedIcon) -> IO ThemedIcon)
-> (Ptr CString -> IO ThemedIcon) -> IO ThemedIcon
forall a b. (a -> b) -> a -> b
$ \ Ptr CString
iconNamesPtr ->
      Ptr CString -> CInt -> IO (Ptr Icon)
g_themed_icon_new_from_names Ptr CString
iconNamesPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
      IO (Ptr Icon) -> (Ptr Icon -> IO ThemedIcon) -> IO ThemedIcon
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((ForeignPtr ThemedIcon -> ThemedIcon, FinalizerPtr ThemedIcon)
-> IO (Ptr ThemedIcon) -> IO ThemedIcon
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr ThemedIcon -> ThemedIcon, FinalizerPtr ThemedIcon)
forall {a}. (ForeignPtr ThemedIcon -> ThemedIcon, FinalizerPtr a)
mkThemedIcon (IO (Ptr ThemedIcon) -> IO ThemedIcon)
-> (Ptr ThemedIcon -> IO (Ptr ThemedIcon))
-> Ptr ThemedIcon
-> IO ThemedIcon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ThemedIcon -> IO (Ptr ThemedIcon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) (Ptr ThemedIcon -> IO ThemedIcon)
-> (Ptr Icon -> Ptr ThemedIcon) -> Ptr Icon -> IO ThemedIcon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Icon -> Ptr ThemedIcon
forall a b. Ptr a -> Ptr b
castPtr


-- | Prepend a name to the list of icons from within icon.
themedIconPrependName :: (ThemedIconClass icon, GlibString string) => icon
 -> string -- ^ @iconname@ name of icon to prepend to list of icons from within icon.
 -> IO ()
themedIconPrependName :: forall icon string.
(ThemedIconClass icon, GlibString string) =>
icon -> string -> IO ()
themedIconPrependName icon
icon string
iconname =
  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 ->
  (\(ThemedIcon ForeignPtr ThemedIcon
arg1) CString
arg2 -> ForeignPtr ThemedIcon -> (Ptr ThemedIcon -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ThemedIcon
arg1 ((Ptr ThemedIcon -> IO ()) -> IO ())
-> (Ptr ThemedIcon -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ThemedIcon
argPtr1 ->Ptr ThemedIcon -> CString -> IO ()
g_themed_icon_prepend_name Ptr ThemedIcon
argPtr1 CString
arg2) (icon -> ThemedIcon
forall o. ThemedIconClass o => o -> ThemedIcon
toThemedIcon icon
icon) CString
iconnamePtr


-- | Append a name to the list of icons from within icon.
themedIconAppendName :: (ThemedIconClass icon, GlibString string) => icon
 -> string -- ^ @iconname@ name of icon to append to list of icons from within icon.
 -> IO ()
themedIconAppendName :: forall icon string.
(ThemedIconClass icon, GlibString string) =>
icon -> string -> IO ()
themedIconAppendName icon
icon string
iconname =
  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 ->
  (\(ThemedIcon ForeignPtr ThemedIcon
arg1) CString
arg2 -> ForeignPtr ThemedIcon -> (Ptr ThemedIcon -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ThemedIcon
arg1 ((Ptr ThemedIcon -> IO ()) -> IO ())
-> (Ptr ThemedIcon -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ThemedIcon
argPtr1 ->Ptr ThemedIcon -> CString -> IO ()
g_themed_icon_append_name Ptr ThemedIcon
argPtr1 CString
arg2) (icon -> ThemedIcon
forall o. ThemedIconClass o => o -> ThemedIcon
toThemedIcon icon
icon) CString
iconnamePtr

-- | Gets the names of icons from within icon.
themedIconGetNames :: (ThemedIconClass icon, GlibString string) => icon
 -> IO [string] -- ^ returns a list of icon names.
themedIconGetNames :: forall icon string.
(ThemedIconClass icon, GlibString string) =>
icon -> IO [string]
themedIconGetNames icon
icon =
  (\(ThemedIcon ForeignPtr ThemedIcon
arg1) -> ForeignPtr ThemedIcon
-> (Ptr ThemedIcon -> IO (Ptr CString)) -> IO (Ptr CString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ThemedIcon
arg1 ((Ptr ThemedIcon -> IO (Ptr CString)) -> IO (Ptr CString))
-> (Ptr ThemedIcon -> IO (Ptr CString)) -> IO (Ptr CString)
forall a b. (a -> b) -> a -> b
$ \Ptr ThemedIcon
argPtr1 ->Ptr ThemedIcon -> IO (Ptr CString)
g_themed_icon_get_names Ptr ThemedIcon
argPtr1) (icon -> ThemedIcon
forall o. ThemedIconClass o => o -> ThemedIcon
toThemedIcon icon
icon)
  IO (Ptr CString) -> (Ptr CString -> IO [string]) -> IO [string]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CString -> IO [string]
forall s. GlibString s => Ptr CString -> IO [s]
readUTFStringArray0

foreign import ccall safe "g_themed_icon_new"
  g_themed_icon_new :: ((Ptr CChar) -> (IO (Ptr Icon)))

foreign import ccall safe "g_themed_icon_new_from_names"
  g_themed_icon_new_from_names :: ((Ptr (Ptr CChar)) -> (CInt -> (IO (Ptr Icon))))

foreign import ccall safe "g_themed_icon_prepend_name"
  g_themed_icon_prepend_name :: ((Ptr ThemedIcon) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "g_themed_icon_append_name"
  g_themed_icon_append_name :: ((Ptr ThemedIcon) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "g_themed_icon_get_names"
  g_themed_icon_get_names :: ((Ptr ThemedIcon) -> (IO (Ptr (Ptr CChar))))