{-# LINE 2 "./Graphics/UI/Gtk/SourceView/SourceStyle/Internal.chs" #-}
{-# OPTIONS_HADDOCK hide #-}
module Graphics.UI.Gtk.SourceView.SourceStyle.Internal (
sourceStyleFromObject,
sourceStyleToObject
) where
import Control.Monad (liftM, sequence)
import Data.Maybe (catMaybes)
import Graphics.UI.Gtk.SourceView.SourceStyle
import System.Glib.FFI
import System.Glib.GType (GType)
import System.Glib.GValue (GValue, valueInit, allocaGValue)
import System.Glib.GValueTypes (valueSetString, valueSetBool)
import qualified System.Glib.GTypeConstants as GType
import Graphics.UI.Gtk.SourceView.Types
{-# LINE 45 "./Graphics/UI/Gtk/SourceView/SourceStyle/Internal.chs" #-}
import System.Glib.GObject (objectNew, constructNewGObject)
import System.Glib.Properties
{-# LINE 47 "./Graphics/UI/Gtk/SourceView/SourceStyle/Internal.chs" #-}
{-# LINE 49 "./Graphics/UI/Gtk/SourceView/SourceStyle/Internal.chs" #-}
sourceStyleFromObject :: SourceStyleObject -> IO SourceStyle
sourceStyleFromObject obj = do
background <- objectGetPropertyMaybeString "background" obj
backgroundSet <- objectGetPropertyBool "background-set" obj
bold <- objectGetPropertyBool "bold" obj
boldSet <- objectGetPropertyBool "bold-set" obj
foreground <- objectGetPropertyMaybeString "foreground" obj
foregroundSet <- objectGetPropertyBool "foreground-set" obj
italic <- objectGetPropertyBool "italic" obj
italicSet <- objectGetPropertyBool "italic-set" obj
lineBackground <- objectGetPropertyMaybeString "line-background" obj
lineBackgroundSet <- objectGetPropertyBool "line-background-set" obj
strikethrough <- objectGetPropertyBool "strikethrough" obj
strikethroughSet <- objectGetPropertyBool "strikethrough-set" obj
underline <- objectGetPropertyBool "underline" obj
underlineSet <- objectGetPropertyBool "underline-set" obj
return $ SourceStyle
{ sourceStyleBackground = if backgroundSet then background else Nothing
, sourceStyleBold = if boldSet then Just bold else Nothing
, sourceStyleForeground = if foregroundSet then foreground else Nothing
, sourceStyleItalic = if italicSet then Just italic else Nothing
, sourceStyleLineBackground = if lineBackgroundSet then lineBackground else Nothing
, sourceStyleStrikethrough = if strikethroughSet then Just strikethrough else Nothing
, sourceStyleUnderline = if underlineSet then Just underline else Nothing
}
sourceStyleToObject :: SourceStyle -> IO SourceStyleObject
sourceStyleToObject ss =
allocaGValue $ \backgroundV ->
allocaGValue $ \backgroundSetV ->
allocaGValue $ \boldV ->
allocaGValue $ \boldSetV ->
allocaGValue $ \foregroundV ->
allocaGValue $ \foregroundSetV ->
allocaGValue $ \italicV ->
allocaGValue $ \italicSetV ->
allocaGValue $ \lineBackgroundV ->
allocaGValue $ \lineBackgroundSetV ->
allocaGValue $ \strikethroughV ->
allocaGValue $ \strikethroughSetV ->
allocaGValue $ \underlineV ->
allocaGValue $ \underlineSetV -> do
params <- liftM concat . sequence $
[ makeParam "background" sourceStyleBackground backgroundSetV backgroundV GType.string valueSetString
, makeParam "bold" sourceStyleBold boldSetV boldV GType.bool valueSetBool
, makeParam "foreground" sourceStyleForeground foregroundSetV foregroundV GType.string valueSetString
, makeParam "italic" sourceStyleItalic italicSetV italicV GType.bool valueSetBool
, makeParam "line-background" sourceStyleLineBackground lineBackgroundSetV lineBackgroundV GType.string valueSetString
, makeParam "strikethrough" sourceStyleStrikethrough strikethroughSetV strikethroughV GType.bool valueSetBool
, makeParam "underline" sourceStyleUnderline underlineSetV underlineV GType.bool valueSetBool
]
constructNewGObject mkSourceStyleObject (liftM castPtr $ objectNew gTypeSourceStyleObject params)
where makeParam name field setV v gtype valueSet = do
valueInit setV GType.bool
case field ss of
Just field' -> do
valueSetBool setV True
valueInit v gtype
valueSet v field'
return [(name ++ "-set", setV), (name, v)]
Nothing -> do
valueSetBool setV False
return [(name ++ "-set", setV)]