{-# 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
-- 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)
--
module Graphics.UI.Gtk.SourceView.SourceView (
-- * Description
-- | 'SourceView' is the main object of the gtksourceview library. It provides a text view which syntax
-- highlighting, undo/redo and text marks. Use a 'SourceBuffer' to display text with a 'SourceView'.

-- * Types
  SourceView,
  SourceViewClass,

-- * Enums
  SourceSmartHomeEndType(..),
  SourceDrawSpacesFlags(..),
  SourceViewGutterPosition (..),

-- * Methods
  castToSourceView,
  gTypeSourceView,
  toSourceView,
  sourceViewNew,
  sourceViewNewWithBuffer,
  sourceViewSetAutoIndent,
  sourceViewGetAutoIndent,
  sourceViewSetIndentOnTab,
  sourceViewGetIndentOnTab,
  sourceViewSetIndentWidth,
  sourceViewGetIndentWidth,
  sourceViewSetInsertSpacesInsteadOfTabs,
  sourceViewGetInsertSpacesInsteadOfTabs,
  sourceViewSetSmartHomeEnd,
  sourceViewGetSmartHomeEnd,
{-# LINE 67 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
  sourceViewSetHighlightCurrentLine,
  sourceViewGetHighlightCurrentLine,
  sourceViewSetShowLineMarks,
  sourceViewGetShowLineMarks,
  sourceViewSetShowLineNumbers,
  sourceViewGetShowLineNumbers,
  sourceViewSetShowRightMargin,
  sourceViewGetShowRightMargin,
  sourceViewSetRightMarginPosition,
  sourceViewGetRightMarginPosition,
  sourceViewSetTabWidth,
  sourceViewGetTabWidth,
  sourceViewSetDrawSpaces,
  sourceViewGetDrawSpaces,
  sourceViewGetGutter,






  sourceViewGetVisualColumn,
  sourceViewSetMarkAttributes,
  sourceViewGetMarkAttributes,


-- * Attributes
  sourceViewAutoIndent,
  sourceViewCompletion,
  sourceViewDrawSpaces,
  sourceViewHighlightCurrentLine,
  sourceViewIndentOnTab,
  sourceViewIndentWidth,
  sourceViewInsertSpacesInsteadOfTabs,
  sourceViewRightMarginPosition,
  sourceViewShowLineNumbers,
  sourceViewShowRightMargin,
  sourceViewSmartHomeEnd,
  sourceViewTabWidth,

-- * Signals
  sourceViewUndo,
  sourceViewRedo,
  sourceViewMoveLines,
  sourceViewShowCompletion,
  sourceViewLineMarkActivated,

-- * Deprecated






  ) where

import Control.Applicative
import Prelude
import Control.Monad (liftM)
import Control.Monad.Reader ( runReaderT )
import Data.Maybe (fromMaybe)

import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Abstract.Widget (Color)
import Graphics.UI.Gtk.Gdk.EventM (EventM, EAny)
import Graphics.UI.Gtk.Multiline.TextView (TextWindowType (..))
import Graphics.UI.Gtk.SourceView.Enums
import Graphics.UI.GtkInternals ( TextIter, mkTextIterCopy )
import System.Glib.GObject (wrapNewGObject, makeNewGObject)
import System.Glib.Attributes
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Flags (toFlags, fromFlags)

import Graphics.UI.Gtk.SourceView.Signals
{-# LINE 142 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
import Graphics.UI.Gtk.SourceView.Types
{-# LINE 143 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
import System.Glib.Properties
{-# LINE 144 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}


{-# LINE 146 "./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 152 "./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

-- | If 'True' auto indentation of text is enabled.
--
sourceViewSetAutoIndent :: SourceViewClass sv => sv
                        -> Bool -- ^ @enable@ whether to enable auto indentation.
                        -> IO ()
sourceViewSetAutoIndent sv enable =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_auto_indent argPtr1 arg2) (toSourceView sv) (fromBool enable)

-- | Returns whether auto indentation of text is enabled.
--
sourceViewGetAutoIndent :: SourceViewClass sv => sv
                        -> IO Bool -- ^ returns 'True' if auto indentation is enabled.
sourceViewGetAutoIndent sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_auto_indent argPtr1) (toSourceView sv)

-- | If 'True', when the tab key is pressed and there is a selection, the selected text is indented of one
-- level instead of being replaced with the \t characters. Shift+Tab unindents the selection.
--
sourceViewSetIndentOnTab :: SourceViewClass sv => sv
                         -> Bool -- ^ @enable@ whether to indent a block when tab is pressed.
                         -> IO ()
sourceViewSetIndentOnTab sv enable =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_indent_on_tab argPtr1 arg2) (toSourceView sv) (fromBool enable)

-- | Returns whether when the tab key is pressed the current selection should get indented instead of
-- replaced with the \t character.
--
sourceViewGetIndentOnTab :: SourceViewClass sv => sv
                         -> IO Bool -- ^ returns 'True' if the selection is indented when tab is pressed.
sourceViewGetIndentOnTab sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_indent_on_tab argPtr1) (toSourceView sv)

-- | Sets the number of spaces to use for each step of indent. If width is -1, the value of the
-- 'tabWidth' property will be used.
--
sourceViewSetIndentWidth :: SourceViewClass sv => sv
                         -> Int -- ^ @width@ indent width in characters.
                         -> IO ()
sourceViewSetIndentWidth sv width =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_indent_width argPtr1 arg2) (toSourceView sv) (fromIntegral width)

-- | Returns the number of spaces to use for each step of indent. See 'sourceViewSetIndentWidth'
-- for details.
--
sourceViewGetIndentWidth :: SourceViewClass sv => sv
                         -> IO Int -- ^ returns indent width.
sourceViewGetIndentWidth sv = liftM fromIntegral $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_indent_width argPtr1) (toSourceView sv)

-- | If 'True' any tabulator character inserted is replaced by a group of space characters.
--
sourceViewSetInsertSpacesInsteadOfTabs :: SourceViewClass sv => sv
                                       -> Bool -- ^ @enable@ whether to insert spaces instead of tabs.
                                       -> IO ()
sourceViewSetInsertSpacesInsteadOfTabs sv enable =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_insert_spaces_instead_of_tabs argPtr1 arg2) (toSourceView sv) (fromBool enable)

-- | Returns whether when inserting a tabulator character it should be replaced by a group of space
-- characters.
--
sourceViewGetInsertSpacesInsteadOfTabs :: SourceViewClass sv => sv
                                       -> IO Bool -- ^ returns 'True' if spaces are inserted instead of tabs.
sourceViewGetInsertSpacesInsteadOfTabs sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_insert_spaces_instead_of_tabs argPtr1) (toSourceView sv)

-- | Set the desired movement of the cursor when HOME and END keys are pressed.
--
sourceViewSetSmartHomeEnd :: SourceViewClass sv => sv
                          -> SourceSmartHomeEndType -- ^ @smartHe@ the desired behavior among '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)

-- | Returns a 'SourceSmartHomeEndType' end value specifying how the cursor will move when HOME and END
-- keys are pressed.
--
sourceViewGetSmartHomeEnd :: SourceViewClass sv => sv
                          -> IO SourceSmartHomeEndType -- ^ returns a 'SourceSmartHomeEndTypeend' value.
sourceViewGetSmartHomeEnd sv = liftM (toEnum . fromIntegral) $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_smart_home_end argPtr1) (toSourceView sv)

-- | If show is 'True' the current line is highlighted.
--
sourceViewSetHighlightCurrentLine :: SourceViewClass sv => sv
                                  -> Bool -- ^ @show@ whether to highlight the current line
                                  -> IO ()
sourceViewSetHighlightCurrentLine sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_highlight_current_line argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- | Returns whether the current line is highlighted
--
sourceViewGetHighlightCurrentLine :: SourceViewClass sv => sv
                                  -> IO Bool -- ^ returns 'True' if the current line is highlighted.
sourceViewGetHighlightCurrentLine sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_highlight_current_line argPtr1) (toSourceView sv)

-- | If 'True' line marks will be displayed beside the text.
--
sourceViewSetShowLineMarks :: SourceViewClass sv => sv
                           -> Bool -- ^ @show@ whether line marks should be displayed.
                           -> IO ()
sourceViewSetShowLineMarks sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_show_line_marks argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- | Returns whether line marks are displayed beside the text.
--
sourceViewGetShowLineMarks :: SourceViewClass sv => sv
                           -> IO Bool -- ^ returns 'True' if the line marks are displayed.
sourceViewGetShowLineMarks sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_show_line_marks argPtr1) (toSourceView sv)

-- | If 'True' line numbers will be displayed beside the text.
--
sourceViewSetShowLineNumbers :: SourceViewClass sv => sv
                             -> Bool -- ^ @show@ whether line numbers should be displayed.
                             -> IO ()
sourceViewSetShowLineNumbers sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_show_line_numbers argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- | Returns whether line numbers are displayed beside the text.
--
sourceViewGetShowLineNumbers :: SourceViewClass sv => sv
                             -> IO Bool -- ^ returns 'True' if the line numbers are displayed.
sourceViewGetShowLineNumbers sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_show_line_numbers argPtr1) (toSourceView sv)

-- | If 'True' a right margin is displayed
--
sourceViewSetShowRightMargin :: SourceViewClass sv => sv
                             -> Bool -- ^ @show@ whether to show a right margin.
                             -> IO ()
sourceViewSetShowRightMargin sv newVal =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_show_right_margin argPtr1 arg2) (toSourceView sv) (fromBool newVal)

-- | Returns whether a right margin is displayed.
--
sourceViewGetShowRightMargin :: SourceViewClass sv => sv
                             -> IO Bool -- ^ returns 'True' if the right margin is shown.
sourceViewGetShowRightMargin sv = liftM toBool $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_show_right_margin argPtr1) (toSourceView sv)

-- | Sets the position of the right margin in the given view.
--
sourceViewSetRightMarginPosition :: SourceViewClass sv => sv
                                 -> Word -- ^ @pos@ the width in characters where to position the right margin.
                                 -> IO ()
sourceViewSetRightMarginPosition sv margin =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_right_margin_position argPtr1 arg2) (toSourceView sv) (fromIntegral margin)

-- | Gets the position of the right margin in the given view.
--
sourceViewGetRightMarginPosition :: SourceViewClass sv => sv
                                 -> IO Int -- ^ returns the position of the right margin.
sourceViewGetRightMarginPosition sv = liftM fromIntegral $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_right_margin_position argPtr1) (toSourceView sv)

-- | Sets the width of tabulation in characters.
--
sourceViewSetTabWidth :: SourceViewClass sv => sv
                      -> Int -- ^ @width@ width of tab in characters.
                      -> IO ()
sourceViewSetTabWidth sv width =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_tab_width argPtr1 arg2) (toSourceView sv) (fromIntegral width)

-- | Returns the width of tabulation in characters.
--
sourceViewGetTabWidth :: SourceViewClass sv => sv
                      -> IO Int -- ^ returns width of tab.
sourceViewGetTabWidth sv = liftM fromIntegral $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_tab_width argPtr1) (toSourceView sv)

-- | Set if and how the spaces should be visualized. Specifying flags as [] will disable display of
-- spaces.
sourceViewSetDrawSpaces :: SourceViewClass sv => sv
                        -> [SourceDrawSpacesFlags] -- ^ @flags@ 'SourceDrawSpacesFlags' specifing how white spaces should be displayed
                        -> IO ()
sourceViewSetDrawSpaces view flags =
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_set_draw_spaces argPtr1 arg2)
{-# LINE 338 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
    (toSourceView view)
    (fromIntegral $ fromFlags flags)

-- | Returns the 'SourceDrawSpacesFlags' specifying if and how spaces should be displayed for this view.
sourceViewGetDrawSpaces :: SourceViewClass sv => sv
                        -> IO [SourceDrawSpacesFlags] -- ^ returns the 'SourceDrawSpacesFlags', [] if no spaces should be drawn.
sourceViewGetDrawSpaces view =
  liftM (toFlags . fromIntegral) $
  (\(SourceView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_draw_spaces argPtr1)
{-# LINE 347 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
     (toSourceView view)

-- | Returns the 'SourceGutter' object associated with @windowType@ for view. Only 'TextWindowLeft'
-- and 'TextWindowRight' are supported, respectively corresponding to the left and right
-- gutter. The line numbers and mark category icons are rendered in the gutter corresponding to
-- 'TextWindowLeft'.
sourceViewGetGutter :: SourceViewClass sv => sv
                    -> TextWindowType -- ^ @windowType@ the gutter window type
                    -> IO SourceGutter
sourceViewGetGutter sv windowType =
  makeNewGObject mkSourceGutter $
  (\(SourceView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_gutter argPtr1 arg2)
{-# LINE 359 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
    (toSourceView sv)
    (fromIntegral $ fromEnum windowType)
{-# LINE 482 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
-- | Determines the visual column at iter taking into consideration the `tabWidth` of the view.
--
sourceViewGetVisualColumn :: SourceViewClass sv
                          => sv
                          -> TextIter -- ^ @iter@ a position in view.
                          -> IO Word
sourceViewGetVisualColumn sv iter = fromIntegral <$>
    (\(SourceView arg1) (TextIter arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_source_view_get_visual_column argPtr1 argPtr2)
{-# LINE 490 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
      (toSourceView sv)
      iter

-- | Sets attributes and priority for the category.
--
sourceViewSetMarkAttributes :: (SourceViewClass sv, GlibString category, SourceMarkAttributesClass attributes)
                            => sv
                            -> category
                            -> Maybe attributes
                            -> Int
                            -> IO ()
sourceViewSetMarkAttributes sv category attributes priority =
  withUTFString category $ \categoryPtr ->
    (\(SourceView arg1) arg2 (SourceMarkAttributes arg3) arg4 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg3 $ \argPtr3 ->gtk_source_view_set_mark_attributes argPtr1 arg2 argPtr3 arg4)
{-# LINE 504 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
      (toSourceView sv)
      categoryPtr
      (maybe (SourceMarkAttributes nullForeignPtr) toSourceMarkAttributes attributes)
      (fromIntegral priority)

-- | Gets attributes and priority for the category
--
sourceViewGetMarkAttributes :: (SourceViewClass sv, GlibString category)
                            => sv
                            -> category
                            -> IO (Maybe (SourceMarkAttributes, Int))
sourceViewGetMarkAttributes sv category =
  withUTFString category $ \categoryPtr ->
  alloca $ \ priority -> do
    attributes <- maybeNull (makeNewObject mkSourceMarkAttributes) $
                        (\(SourceView arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_view_get_mark_attributes argPtr1 arg2 arg3)
{-# LINE 520 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}
                          (toSourceView sv)
                          categoryPtr
                          priority
    case attributes of
        Just a -> do
            p <- peek priority
            return $ Just (a, fromIntegral p)
        Nothing -> return Nothing


-- | Whether to enable auto indentation.
--
-- Default value: 'False'
--
sourceViewAutoIndent :: SourceViewClass sv => Attr sv Bool
sourceViewAutoIndent = newAttrFromBoolProperty "auto-indent"

-- | The completion object associated with the view.
--
sourceViewCompletion :: SourceViewClass sv => ReadAttr sv SourceCompletion
sourceViewCompletion = readAttrFromObjectProperty "completion"
                       gtk_source_completion_get_type
{-# LINE 542 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}

-- | Set if and how the spaces should be visualized.
--
sourceViewDrawSpaces :: SourceViewClass sv => Attr sv [SourceDrawSpacesFlags]
sourceViewDrawSpaces = newAttrFromFlagsProperty "draw-spaces" gtk_source_draw_spaces_flags_get_type
{-# LINE 547 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}

-- | Whether to highlight the current line.
--
-- Default value: 'False'
--
sourceViewHighlightCurrentLine :: SourceViewClass sv => Attr sv Bool
sourceViewHighlightCurrentLine = newAttrFromBoolProperty "highlight-current-line"

-- | Whether to indent the selected text when the tab key is pressed.
--
-- Default value: 'True'
--
sourceViewIndentOnTab :: SourceViewClass sv => Attr sv Bool
sourceViewIndentOnTab = newAttrFromBoolProperty "indent-on-tab"

-- | Width of an indentation step expressed in number of spaces.
--
-- Allowed values: [GMaxulong,32]
--
-- Default value: -1
--
sourceViewIndentWidth :: SourceViewClass sv => Attr sv Int
sourceViewIndentWidth = newAttrFromIntProperty "indent-width"

-- | Whether to insert spaces instead of tabs.
--
-- Default value: 'False'
--
sourceViewInsertSpacesInsteadOfTabs :: SourceViewClass sv => Attr sv Bool
sourceViewInsertSpacesInsteadOfTabs = newAttrFromBoolProperty "insert-spaces-instead-of-tabs"

-- | Position of the right margin.
--
-- Allowed values: [1,200]
--
-- Default value: 80
--
sourceViewRightMarginPosition :: SourceViewClass sv => Attr sv Int
sourceViewRightMarginPosition = newAttrFromUIntProperty "right-margin-position"

-- | Whether to display line numbers
--
-- Default value: 'False'
--
sourceViewShowLineNumbers :: SourceViewClass sv => Attr sv Bool
sourceViewShowLineNumbers = newAttrFromBoolProperty "show-line-numbers"

-- | Whether to display line mark pixbufs
--
-- Default value: 'False'
--
sourceViewShowRightMargin :: SourceViewClass sv => Attr sv Bool
sourceViewShowRightMargin = newAttrFromBoolProperty "show-right-margin"

-- | Set the behavior of the HOME and END keys.
--
-- Default value: 'SourceSmartHomeEndDisabled'
--
-- Since 2.0
--
sourceViewSmartHomeEnd :: SourceViewClass sv => Attr sv SourceSmartHomeEndType
sourceViewSmartHomeEnd = newAttrFromEnumProperty "smart-home-end" gtk_source_smart_home_end_type_get_type
{-# LINE 609 "./Graphics/UI/Gtk/SourceView/SourceView.chs" #-}

-- | Width of an tab character expressed in number of spaces.
--
-- Allowed values: [1,32]
--
-- Default value: 8
--
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"

-- | The 'moveLines' signal is a keybinding which gets emitted when the user initiates moving a
-- line. The default binding key is Alt+Up/Down arrow. And moves the currently selected lines, or the
-- current line by count. For the moment, only count of -1 or 1 is valid.
sourceViewMoveLines :: SourceViewClass sv => Signal sv (Bool -> Int -> IO ())
sourceViewMoveLines = Signal $ connect_BOOL_INT__NONE "move-lines"

-- | The 'showCompletion' signal is a keybinding signal which gets emitted when the user initiates a
-- completion in default mode.
--
-- Applications should not connect to it, but may emit it with @gSignalEmitByName@ if they need to
-- control the default mode completion activation.
sourceViewShowCompletion :: SourceViewClass sv => Signal sv (IO ())
sourceViewShowCompletion = Signal $ connect_NONE__NONE "show-completion"

-- | Emitted when a line mark has been activated (for instance when there was a button press in the line
-- marks gutter). You can use iter to determine on which line the activation took place.
sourceViewLineMarkActivated :: SourceViewClass sv => Signal sv (TextIter -> EventM EAny ())
sourceViewLineMarkActivated =
  Signal (\after obj fun ->
           connect_BOXED_PTR__NONE "line-mark-activated" mkTextIterCopy after obj
                                   (\iter eventPtr -> runReaderT (fun iter) eventPtr)
         )

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_draw_spaces"
  gtk_source_view_set_draw_spaces :: ((Ptr SourceView) -> (CInt -> (IO ())))

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

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

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

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

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

foreign import ccall unsafe "gtk_source_completion_get_type"
  gtk_source_completion_get_type :: CULong

foreign import ccall safe "gtk_source_draw_spaces_flags_get_type"
  gtk_source_draw_spaces_flags_get_type :: CULong

foreign import ccall safe "gtk_source_smart_home_end_type_get_type"
  gtk_source_smart_home_end_type_get_type :: CULong