{-# LINE 2 "./Graphics/UI/Gtk/SourceView/SourceStyleScheme.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) SourceStyleScheme
--
-- Author : Peter Gavin
-- derived from sourceview bindings by Axel Simon and Duncan Coutts
--
-- Created: 18 December 2008
--
-- Copyright (C) 2004-2008 Peter Gavin, Duncan Coutts, Axel Simon
--
-- 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)
--
module Graphics.UI.Gtk.SourceView.SourceStyleScheme (
-- * Description
-- | 'SourceStyleScheme' contains all the text styles to be used in 'SourceView' and
-- 'SourceBuffer'. For instance, it contains text styles for syntax highlighting, it may contain
-- foreground and background color for non-highlighted text, color for the line numbers, etc.
--
-- Style schemes are stored in XML files. The format of a scheme file is the documented in the style
-- scheme reference.

-- * Types
  SourceStyleScheme,
  SourceStyleSchemeClass,

-- * Methods
  castToSourceStyleScheme,
  gTypeSourceStyleScheme,
  toSourceStyleScheme,
  sourceStyleSchemeGetId,
  sourceStyleSchemeGetName,
  sourceStyleSchemeGetDescription,
  sourceStyleSchemeGetAuthors,
  sourceStyleSchemeGetFilename,
  sourceStyleSchemeGetStyle,

-- * Attributes
  sourceStyleSchemeDescription,
  sourceStyleSchemeFilename,
  sourceStyleSchemeId,
  sourceStyleSchemeName,
  ) where

import Control.Monad (liftM)

import Graphics.UI.Gtk.SourceView.SourceStyle
import System.Glib.Attributes
import System.Glib.FFI
import System.Glib.GObject (makeNewGObject)
import System.Glib.UTFString

import Graphics.UI.Gtk.SourceView.SourceStyle.Internal
{-# LINE 67 "./Graphics/UI/Gtk/SourceView/SourceStyleScheme.chs" #-}
import Graphics.UI.Gtk.SourceView.Types
{-# LINE 68 "./Graphics/UI/Gtk/SourceView/SourceStyleScheme.chs" #-}
import System.Glib.Properties
{-# LINE 69 "./Graphics/UI/Gtk/SourceView/SourceStyleScheme.chs" #-}


{-# LINE 71 "./Graphics/UI/Gtk/SourceView/SourceStyleScheme.chs" #-}

-- methods

-- |
--
sourceStyleSchemeGetId :: (SourceStyleSchemeClass sss, GlibString string) => sss
                       -> IO string -- ^ returns scheme id.
sourceStyleSchemeGetId ss =
  (\(SourceStyleScheme arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_style_scheme_get_id argPtr1) (toSourceStyleScheme ss) >>= peekUTFString

-- |
--
sourceStyleSchemeGetName :: (SourceStyleSchemeClass sss, GlibString string) => sss
                         -> IO string -- ^ returns scheme name.
sourceStyleSchemeGetName ss =
  (\(SourceStyleScheme arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_style_scheme_get_name argPtr1) (toSourceStyleScheme ss) >>= peekUTFString

-- |
--
sourceStyleSchemeGetDescription :: (SourceStyleSchemeClass sss, GlibString string) => sss
                                -> IO string -- ^ returns scheme description (if defined) or empty.
sourceStyleSchemeGetDescription ss =
  (\(SourceStyleScheme arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_style_scheme_get_description argPtr1) (toSourceStyleScheme ss) >>= peekUTFString

-- |
--
sourceStyleSchemeGetAuthors :: (SourceStyleSchemeClass sss, GlibString string) => sss
                            -> IO [string] -- ^ returns an array containing the scheme authors or empty if no author is specified by the style scheme.
sourceStyleSchemeGetAuthors ss =
  (\(SourceStyleScheme arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_style_scheme_get_authors argPtr1) (toSourceStyleScheme ss) >>= peekUTFStringArray0

-- |
--
sourceStyleSchemeGetFilename :: (SourceStyleSchemeClass sss, GlibString string) => sss
                             -> IO string -- ^ returns scheme file name if the scheme was created parsing a style scheme file or empty in the other cases.
sourceStyleSchemeGetFilename ss =
  (\(SourceStyleScheme arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_style_scheme_get_filename argPtr1) (toSourceStyleScheme ss) >>= peekUTFString

-- |
--
sourceStyleSchemeGetStyle :: (SourceStyleSchemeClass sss, GlibString string) => sss
                          -> string -- ^ @styleId@ id of the style to retrieve.
                          -> IO SourceStyle -- ^ returns style which corresponds to @styleId@ in the scheme
sourceStyleSchemeGetStyle ss id = do
  styleObj <- makeNewGObject mkSourceStyleObject $
              withUTFString id ((\(SourceStyleScheme arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_style_scheme_get_style argPtr1 arg2) (toSourceStyleScheme ss))
  sourceStyleFromObject styleObj

-- | Style scheme description.
--
-- Default value: \"\"
--
sourceStyleSchemeDescription :: (SourceStyleSchemeClass sss, GlibString string) => ReadAttr sss string
sourceStyleSchemeDescription = readAttrFromStringProperty "description"

-- | Style scheme filename or 'Nothing'.
--
-- Default value: \"\"
--
sourceStyleSchemeFilename :: (SourceStyleSchemeClass sss, GlibFilePath fp) => ReadAttr sss fp
sourceStyleSchemeFilename = readAttrFromFilePathProperty "filename"

-- | Style scheme id, a unique string used to identify the style scheme in 'SourceStyleSchemeManager'.
--
-- Default value: \"\"
--
sourceStyleSchemeId :: (SourceStyleSchemeClass sss, GlibString string) => ReadAttr sss string
sourceStyleSchemeId = readAttrFromStringProperty "id"

-- | Style scheme name, a translatable string to present to user.
--
-- Default value: \"\"
--
sourceStyleSchemeName :: (SourceStyleSchemeClass sss, GlibString string) => ReadAttr sss string
sourceStyleSchemeName = readAttrFromStringProperty "name"

foreign import ccall safe "gtk_source_style_scheme_get_id"
  gtk_source_style_scheme_get_id :: ((Ptr SourceStyleScheme) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_source_style_scheme_get_name"
  gtk_source_style_scheme_get_name :: ((Ptr SourceStyleScheme) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_source_style_scheme_get_description"
  gtk_source_style_scheme_get_description :: ((Ptr SourceStyleScheme) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_source_style_scheme_get_authors"
  gtk_source_style_scheme_get_authors :: ((Ptr SourceStyleScheme) -> (IO (Ptr (Ptr CChar))))

foreign import ccall safe "gtk_source_style_scheme_get_filename"
  gtk_source_style_scheme_get_filename :: ((Ptr SourceStyleScheme) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_source_style_scheme_get_style"
  gtk_source_style_scheme_get_style :: ((Ptr SourceStyleScheme) -> ((Ptr CChar) -> (IO (Ptr SourceStyleObject))))