{-# LINE 2 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget SourceView
--
-- 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.SourceView (
  SourceView,
  SourceViewClass,
  SourceSmartHomeEndType(..),
  castToSourceView,
  sourceViewNew,
  sourceViewNewWithBuffer,
  sourceViewSetAutoIndent,
  sourceViewGetAutoIndent,
  sourceViewSetIndentOnTab,
  sourceViewGetIndentOnTab,
  sourceViewSetIndentWidth,
  sourceViewGetIndentWidth,
  sourceViewSetInsertSpacesInsteadOfTabs,
  sourceViewGetInsertSpacesInsteadOfTabs,
  sourceViewSetSmartHomeEnd,
  sourceViewGetSmartHomeEnd,
  sourceViewSetHighlightCurrentLine,
  sourceViewGetHighlightCurrentLine,
  sourceViewSetShowLineMarks,
  sourceViewGetShowLineMarks,
  sourceViewSetShowLineNumbers,
  sourceViewGetShowLineNumbers,
  sourceViewSetShowRightMargin,
  sourceViewGetShowRightMargin,
  sourceViewSetRightMarginPosition,
  sourceViewGetRightMarginPosition,
  sourceViewSetTabWidth,
  sourceViewGetTabWidth,
  sourceViewSetMarkCategoryPixbuf,
  sourceViewGetMarkCategoryPixbuf,
  sourceViewAutoIndent,
  sourceViewHighlightCurrentLine,
  sourceViewIndentOnTab,
  sourceViewIndentWidth,
  sourceViewInsertSpacesInsteadOfTabs,
  sourceViewRightMarginPosition,
  sourceViewShowLineNumbers,
  sourceViewShowRightMargin,
  sourceViewSmartHomeEnd,
  sourceViewTabWidth,
  sourceViewUndo,
  sourceViewRedo
  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.Properties
{-# LINE 76 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.SourceView.Types
{-# LINE 79 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
import Graphics.UI.Gtk.SourceView.Signals
{-# LINE 80 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}


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

data SourceSmartHomeEndType = SourceSmartHomeEndDisabled
                            | SourceSmartHomeEndBefore
                            | SourceSmartHomeEndAfter
                            | SourceSmartHomeEndAlways
                            deriving (Enum,Eq,Bounded,Show,Read)

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

-- | Create a new 'SourceView' widget with a default 'SourceBuffer'.
--
sourceViewNew :: IO SourceView
sourceViewNew = makeNewObject mkSourceView $ liftM castPtr
  gtk_source_view_new
{-# LINE 90 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}

-- | Create a new 'SourceView'
-- widget with the given 'SourceBuffer'.
--
sourceViewNewWithBuffer :: SourceBuffer -> IO SourceView
sourceViewNewWithBuffer sb = makeNewObject mkSourceView $ liftM castPtr $
  (\(SourceBuffer arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_new_with_buffer argPtr1) sb

-- |
--
sourceViewSetAutoIndent :: SourceViewClass sv => sv -> Bool -> IO ()
sourceViewSetAutoIndent sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_auto_indent argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- |
--
sourceViewGetAutoIndent :: SourceViewClass sv => sv -> IO Bool
sourceViewGetAutoIndent sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_auto_indent argPtr1) (toSourceView sv)

-- |
--
sourceViewSetIndentOnTab :: SourceViewClass sv => sv -> Bool -> IO ()
sourceViewSetIndentOnTab sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_indent_on_tab argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- |
--
sourceViewGetIndentOnTab :: SourceViewClass sv => sv -> IO Bool
sourceViewGetIndentOnTab sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_indent_on_tab argPtr1) (toSourceView sv)

-- |
--
sourceViewSetIndentWidth :: SourceViewClass sv => sv -> Int -> IO ()
sourceViewSetIndentWidth sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_indent_width argPtr1 arg2) (toSourceView sv) (fromIntegral newVal)

-- |
--
sourceViewGetIndentWidth :: SourceViewClass sv => sv -> IO Int
sourceViewGetIndentWidth sv = liftM fromIntegral $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_indent_width argPtr1) (toSourceView sv)

-- |
--
sourceViewSetInsertSpacesInsteadOfTabs :: SourceViewClass sv => sv -> Bool -> IO ()
sourceViewSetInsertSpacesInsteadOfTabs sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_insert_spaces_instead_of_tabs argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- |
--
sourceViewGetInsertSpacesInsteadOfTabs :: SourceViewClass sv => sv -> IO Bool
sourceViewGetInsertSpacesInsteadOfTabs sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_insert_spaces_instead_of_tabs argPtr1) (toSourceView sv)

-- |
--
sourceViewSetSmartHomeEnd :: SourceViewClass sv => sv -> SourceSmartHomeEndType -> IO ()
sourceViewSetSmartHomeEnd sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_smart_home_end argPtr1 arg2) (toSourceView sv) (fromIntegral $ fromEnum newVal)

-- |
--
sourceViewGetSmartHomeEnd :: SourceViewClass sv => sv -> IO SourceSmartHomeEndType
sourceViewGetSmartHomeEnd sv = liftM (toEnum . fromIntegral) $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_smart_home_end argPtr1) (toSourceView sv)

-- |
--
sourceViewSetHighlightCurrentLine :: SourceViewClass sv => sv -> Bool -> IO ()
sourceViewSetHighlightCurrentLine sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_highlight_current_line argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- |
--
sourceViewGetHighlightCurrentLine :: SourceViewClass sv => sv -> IO Bool
sourceViewGetHighlightCurrentLine sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_highlight_current_line argPtr1) (toSourceView sv)

-- |
--
sourceViewSetShowLineMarks :: SourceViewClass sv => sv -> Bool -> IO ()
sourceViewSetShowLineMarks sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_show_line_marks argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- |
--
sourceViewGetShowLineMarks :: SourceViewClass sv => sv -> IO Bool
sourceViewGetShowLineMarks sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_show_line_marks argPtr1) (toSourceView sv)

--- |
--
sourceViewSetShowLineNumbers :: SourceViewClass sv => sv -> Bool -> IO ()
sourceViewSetShowLineNumbers sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_show_line_numbers argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- |
--
sourceViewGetShowLineNumbers :: SourceViewClass sv => sv -> IO Bool
sourceViewGetShowLineNumbers sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_show_line_numbers argPtr1) (toSourceView sv)

-- |
--
sourceViewSetShowRightMargin :: SourceViewClass sv => sv -> Bool -> IO ()
sourceViewSetShowRightMargin sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_show_right_margin argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- |
--
sourceViewGetShowRightMargin :: SourceViewClass sv => sv -> IO Bool
sourceViewGetShowRightMargin sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_show_right_margin argPtr1) (toSourceView sv)

-- |
--
sourceViewSetRightMarginPosition :: SourceViewClass sv => sv -> Word -> IO ()
sourceViewSetRightMarginPosition sv margin =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_right_margin_position argPtr1 arg2) (toSourceView sv) (fromIntegral margin)

-- |
--
sourceViewGetRightMarginPosition :: SourceViewClass sv => sv -> IO Int
sourceViewGetRightMarginPosition sv = liftM fromIntegral $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_right_margin_position argPtr1) (toSourceView sv)

-- |
--
sourceViewSetTabWidth :: SourceViewClass sv => sv -> Int -> IO ()
sourceViewSetTabWidth sv width =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_tab_width argPtr1 arg2) (toSourceView sv) (fromIntegral width)

-- |
--
sourceViewGetTabWidth :: SourceViewClass sv => sv -> IO Int
sourceViewGetTabWidth sv = liftM fromIntegral $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_tab_width argPtr1) (toSourceView sv)

-- |
--
sourceViewSetMarkCategoryPriority :: SourceViewClass sv => sv -> String -> Int -> IO ()
sourceViewSetMarkCategoryPriority sv markerType priority = withCString markerType $ \strPtr ->
  (\(SourceView arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_mark_category_priority argPtr1 arg2 arg3) (toSourceView sv) strPtr (fromIntegral priority)

-- |
--
sourceViewGetMarkCategoryPriority :: SourceViewClass sv => sv -> String -> IO Int
sourceViewGetMarkCategoryPriority sv markerType = withCString markerType $ \strPtr ->
  liftM fromIntegral $
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_mark_category_priority argPtr1 arg2) (toSourceView sv) strPtr

--- |
--
sourceViewSetMarkCategoryPixbuf :: SourceViewClass sv => sv -> String -> Pixbuf -> IO ()
sourceViewSetMarkCategoryPixbuf sv markerType marker = withCString markerType $ \strPtr ->
  (\(SourceView arg1) arg2 (Pixbuf arg3) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg3 $ \argPtr3 ->gtk_source_view_set_mark_category_pixbuf argPtr1 arg2 argPtr3) (toSourceView sv) strPtr marker

-- |
--
sourceViewGetMarkCategoryPixbuf :: SourceViewClass sv => sv -> String -> IO Pixbuf
sourceViewGetMarkCategoryPixbuf sv markerType = withCString markerType $ \strPtr ->
  constructNewGObject mkPixbuf $
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_mark_category_pixbuf argPtr1 arg2) (toSourceView sv) strPtr

-- |
--
sourceViewAutoIndent :: SourceViewClass sv => Attr sv Bool
sourceViewAutoIndent = newAttrFromBoolProperty "auto-indent"

-- |
--
sourceViewHighlightCurrentLine :: SourceViewClass sv => Attr sv Bool
sourceViewHighlightCurrentLine = newAttrFromBoolProperty "highlight-current-line"

-- |
--
sourceViewIndentOnTab :: SourceViewClass sv => Attr sv Bool
sourceViewIndentOnTab = newAttrFromBoolProperty "indent-on-tab"

-- |
--
sourceViewIndentWidth :: SourceViewClass sv => Attr sv Int
sourceViewIndentWidth = newAttrFromIntProperty "indent-width"

-- |
--
sourceViewInsertSpacesInsteadOfTabs :: SourceViewClass sv => Attr sv Bool
sourceViewInsertSpacesInsteadOfTabs = newAttrFromBoolProperty "insert-spaces-instead-of-tabs"

-- |
--
sourceViewRightMarginPosition :: SourceViewClass sv => Attr sv Int
sourceViewRightMarginPosition = newAttrFromUIntProperty "right-margin-position"

-- |
--
sourceViewShowLineNumbers :: SourceViewClass sv => Attr sv Bool
sourceViewShowLineNumbers = newAttrFromBoolProperty "show-line-numbers"

-- |
--
sourceViewShowRightMargin :: SourceViewClass sv => Attr sv Bool
sourceViewShowRightMargin = newAttrFromBoolProperty "show-right-margin"

-- |
--
sourceViewSmartHomeEnd :: SourceViewClass sv => Attr sv SourceSmartHomeEndType
sourceViewSmartHomeEnd = newAttrFromEnumProperty "smart-home-end" gtk_source_smart_home_end_type_get_type
{-# LINE 300 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}

-- |
--
sourceViewTabWidth :: SourceViewClass sv => Attr sv Int
sourceViewTabWidth = newAttrFromUIntProperty "tab-width"

-- |
--
sourceViewUndo :: SourceViewClass sv => Signal sv (IO ())
sourceViewUndo = Signal $ connect_NONE__NONE "undo"

-- |
--
sourceViewRedo :: SourceViewClass sv => Signal sv (IO ())
sourceViewRedo = Signal $ connect_NONE__NONE "redo"

foreign import ccall unsafe "gtk_source_view_new"
  gtk_source_view_new :: (IO (Ptr Widget))

foreign import ccall safe "gtk_source_view_new_with_buffer"
  gtk_source_view_new_with_buffer :: ((Ptr SourceBuffer) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_source_view_set_auto_indent"
  gtk_source_view_set_auto_indent :: ((Ptr SourceView) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_source_view_get_auto_indent"
  gtk_source_view_get_auto_indent :: ((Ptr SourceView) -> (IO CInt))

foreign import ccall safe "gtk_source_view_set_indent_on_tab"
  gtk_source_view_set_indent_on_tab :: ((Ptr SourceView) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_source_view_get_indent_on_tab"
  gtk_source_view_get_indent_on_tab :: ((Ptr SourceView) -> (IO CInt))

foreign import ccall safe "gtk_source_view_set_indent_width"
  gtk_source_view_set_indent_width :: ((Ptr SourceView) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_source_view_get_indent_width"
  gtk_source_view_get_indent_width :: ((Ptr SourceView) -> (IO CInt))

foreign import ccall safe "gtk_source_view_set_insert_spaces_instead_of_tabs"
  gtk_source_view_set_insert_spaces_instead_of_tabs :: ((Ptr SourceView) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_source_view_get_insert_spaces_instead_of_tabs"
  gtk_source_view_get_insert_spaces_instead_of_tabs :: ((Ptr SourceView) -> (IO CInt))

foreign import ccall safe "gtk_source_view_set_smart_home_end"
  gtk_source_view_set_smart_home_end :: ((Ptr SourceView) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_source_view_get_smart_home_end"
  gtk_source_view_get_smart_home_end :: ((Ptr SourceView) -> (IO CInt))

foreign import ccall safe "gtk_source_view_set_highlight_current_line"
  gtk_source_view_set_highlight_current_line :: ((Ptr SourceView) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_source_view_get_highlight_current_line"
  gtk_source_view_get_highlight_current_line :: ((Ptr SourceView) -> (IO CInt))

foreign import ccall safe "gtk_source_view_set_show_line_marks"
  gtk_source_view_set_show_line_marks :: ((Ptr SourceView) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_source_view_get_show_line_marks"
  gtk_source_view_get_show_line_marks :: ((Ptr SourceView) -> (IO CInt))

foreign import ccall safe "gtk_source_view_set_show_line_numbers"
  gtk_source_view_set_show_line_numbers :: ((Ptr SourceView) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_source_view_get_show_line_numbers"
  gtk_source_view_get_show_line_numbers :: ((Ptr SourceView) -> (IO CInt))

foreign import ccall safe "gtk_source_view_set_show_right_margin"
  gtk_source_view_set_show_right_margin :: ((Ptr SourceView) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_source_view_get_show_right_margin"
  gtk_source_view_get_show_right_margin :: ((Ptr SourceView) -> (IO CInt))

foreign import ccall safe "gtk_source_view_set_right_margin_position"
  gtk_source_view_set_right_margin_position :: ((Ptr SourceView) -> (CUInt -> (IO ())))

foreign import ccall unsafe "gtk_source_view_get_right_margin_position"
  gtk_source_view_get_right_margin_position :: ((Ptr SourceView) -> (IO CUInt))

foreign import ccall safe "gtk_source_view_set_tab_width"
  gtk_source_view_set_tab_width :: ((Ptr SourceView) -> (CUInt -> (IO ())))

foreign import ccall unsafe "gtk_source_view_get_tab_width"
  gtk_source_view_get_tab_width :: ((Ptr SourceView) -> (IO CUInt))

foreign import ccall safe "gtk_source_view_set_mark_category_priority"
  gtk_source_view_set_mark_category_priority :: ((Ptr SourceView) -> ((Ptr CChar) -> (CInt -> (IO ()))))

foreign import ccall unsafe "gtk_source_view_get_mark_category_priority"
  gtk_source_view_get_mark_category_priority :: ((Ptr SourceView) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall safe "gtk_source_view_set_mark_category_pixbuf"
  gtk_source_view_set_mark_category_pixbuf :: ((Ptr SourceView) -> ((Ptr CChar) -> ((Ptr Pixbuf) -> (IO ()))))

foreign import ccall unsafe "gtk_source_view_get_mark_category_pixbuf"
  gtk_source_view_get_mark_category_pixbuf :: ((Ptr SourceView) -> ((Ptr CChar) -> (IO (Ptr Pixbuf))))

foreign import ccall safe "gtk_source_smart_home_end_type_get_type"
  gtk_source_smart_home_end_type_get_type :: CUInt