{-# LINE 2 "./Graphics/UI/Gtk/SourceView/SourceGutter.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget SourceGutter
--
-- Author : Andy Stewart
--
-- Created: 08 Aug 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 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.SourceGutter (
-- * Description
-- | The 'SourceGutter' object represents the left and right gutters of the text view. It is used by
-- 'SourceView' to draw the line numbers and category marks that might be present on a line. By
-- packing additional 'CellRenderer' objects in the gutter, you can extend the gutter with your own
-- custom drawings.
--
-- The gutter works very much the same way as cells rendered in a 'TreeView'. The concept is similar,
-- with the exception that the gutter does not have an underlying 'TreeModel'. Instead, you should use
-- 'sourceGutterSetCellDataFunc' to set a callback to fill in any of the cell renderers
-- properties, given the line for which the cell is to be rendered. Renderers are inserted into the
-- gutter at a certain position.
-- The builtin line number renderer is at position
-- 'SourceViewGutterPositionLines (-30)' and the marks renderer is at
-- 'SourceViewGutterPositionMarks (-20)'. You can use these values to position custom renderers
-- accordingly. The width of a cell renderer can be specified as either fixed (using
-- 'cellRendererSetFixedSize') or dynamic, in which case you must set
-- 'sourceGutterSetCellSizeFunc'. This callback is used to set the properties of the renderer
-- such that @gtkCellRendererGetSize@ yields the maximum width of the cell.

-- * Types
    SourceGutter,
    SourceGutterClass,

-- * Methods
    sourceGutterGetWindow,
    sourceGutterInsert,
    sourceGutterReorder,
    sourceGutterRemove,
    sourceGutterQueueDraw,

-- * Attributes
    sourceGutterView,
    sourceGutterWindowType,

-- * Signals
    sourceGutterCellActivated,
    sourceGutterQueryTooltip,
) where

import Control.Monad (liftM)
import Control.Monad.Reader ( runReaderT )

import Graphics.UI.Gtk.Gdk.EventM (EventM, EAny)
import Graphics.UI.Gtk.Multiline.TextView (TextWindowType (..))
import Graphics.UI.GtkInternals ( TextIter, mkTextIterCopy )
import System.Glib.Attributes
import System.Glib.FFI
import System.Glib.GObject (makeNewGObject)
import System.Glib.Properties
import System.Glib.UTFString

import Graphics.UI.Gtk.SourceView.Signals
{-# LINE 79 "./Graphics/UI/Gtk/SourceView/SourceGutter.chs" #-}
import Graphics.UI.Gtk.SourceView.Types
{-# LINE 80 "./Graphics/UI/Gtk/SourceView/SourceGutter.chs" #-}


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

-- | Get the 'Window' of the gutter. The window will only be available when the gutter has at least one,
-- non-zero width, cell renderer packed.
sourceGutterGetWindow :: SourceGutterClass sg => sg -> IO (Maybe DrawWindow)
sourceGutterGetWindow sb =
    maybeNull (makeNewGObject mkDrawWindow) $
    (\(SourceGutter arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_gutter_get_window argPtr1) (toSourceGutter sb)

-- | Inserts renderer into gutter at position.
sourceGutterInsert :: (CellRendererClass cell, SourceGutterClass sg) => sg
                   -> cell -- ^ @renderer@ a 'CellRenderer'
                   -> Int -- ^ @position@ the renderers position
                   -> IO ()
sourceGutterInsert gutter renderer position =
  (\(SourceGutter arg1) (CellRenderer arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_source_gutter_insert argPtr1 argPtr2 arg3)
{-# LINE 97 "./Graphics/UI/Gtk/SourceView/SourceGutter.chs" #-}
     (toSourceGutter gutter)
     (toCellRenderer renderer)
     (fromIntegral position)

-- | Reorders renderer in gutter to new position.
sourceGutterReorder :: (CellRendererClass cell, SourceGutterClass sg) => sg
                    -> cell -- ^ @renderer@ a 'CellRenderer'
                    -> Int -- ^ @position@ the new renderer position
                    -> IO ()
sourceGutterReorder gutter renderer position =
  (\(SourceGutter arg1) (CellRenderer arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_source_gutter_reorder argPtr1 argPtr2 arg3)
{-# LINE 108 "./Graphics/UI/Gtk/SourceView/SourceGutter.chs" #-}
     (toSourceGutter gutter)
     (toCellRenderer renderer)
     (fromIntegral position)

-- | Removes renderer from gutter.
sourceGutterRemove :: (CellRendererClass cell, SourceGutterClass sg) => sg
                   -> cell -- ^ @renderer@ a 'CellRenderer'
                   -> IO ()
sourceGutterRemove gutter renderer =
  (\(SourceGutter arg1) (CellRenderer arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_source_gutter_remove argPtr1 argPtr2)
{-# LINE 118 "./Graphics/UI/Gtk/SourceView/SourceGutter.chs" #-}
     (toSourceGutter gutter)
     (toCellRenderer renderer)

-- | Invalidates the drawable area of the gutter. You can use this to force a redraw of the gutter if
-- something has changed and needs to be redrawn.
sourceGutterQueueDraw :: SourceGutterClass sg => sg -> IO ()
sourceGutterQueueDraw sb =
  (\(SourceGutter arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_gutter_queue_draw argPtr1) (toSourceGutter sb)

-- | The 'SourceView' of the gutter
sourceGutterView :: SourceGutterClass sg => Attr sg SourceView
sourceGutterView = newAttrFromObjectProperty "view"
                   gtk_source_view_get_type
{-# LINE 131 "./Graphics/UI/Gtk/SourceView/SourceGutter.chs" #-}

-- | The text window type on which the window is placed
--
-- Default value: 'TextWindowPrivate'
sourceGutterWindowType :: SourceGutterClass sg => Attr sg TextWindowType
sourceGutterWindowType = newAttrFromEnumProperty "window-type"
                         gtk_text_window_type_get_type
{-# LINE 138 "./Graphics/UI/Gtk/SourceView/SourceGutter.chs" #-}

-- | Emitted when a cell has been activated (for instance when there was a button press on the cell). The
-- signal is only emitted for cells that have the activatable property set to 'True'.
sourceGutterCellActivated :: SourceGutterClass sg => Signal sg (CellRenderer -> TextIter -> EventM EAny ())
sourceGutterCellActivated =
  Signal (\after obj fun ->
           connect_OBJECT_PTR_BOXED__NONE "cell-activated" mkTextIterCopy after obj
                                   (\cr eventPtr iter -> runReaderT (fun cr iter) eventPtr)
         )

-- | Emitted when a tooltip is requested for a specific cell. Signal handlers can return 'True' to notify
-- the tooltip has been handled.
sourceGutterQueryTooltip :: SourceGutterClass sg => Signal sg (CellRenderer -> TextIter -> Tooltip -> IO Bool)
sourceGutterQueryTooltip =
    Signal $ connect_OBJECT_BOXED_OBJECT__BOOL "query-tooltip" mkTextIterCopy

foreign import ccall safe "gtk_source_gutter_get_window"
  gtk_source_gutter_get_window :: ((Ptr SourceGutter) -> (IO (Ptr DrawWindow)))

foreign import ccall safe "gtk_source_gutter_insert"
  gtk_source_gutter_insert :: ((Ptr SourceGutter) -> ((Ptr CellRenderer) -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_source_gutter_reorder"
  gtk_source_gutter_reorder :: ((Ptr SourceGutter) -> ((Ptr CellRenderer) -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_source_gutter_remove"
  gtk_source_gutter_remove :: ((Ptr SourceGutter) -> ((Ptr CellRenderer) -> (IO ())))

foreign import ccall safe "gtk_source_gutter_queue_draw"
  gtk_source_gutter_queue_draw :: ((Ptr SourceGutter) -> (IO ()))

foreign import ccall unsafe "gtk_source_view_get_type"
  gtk_source_view_get_type :: CUInt

foreign import ccall unsafe "gtk_text_window_type_get_type"
  gtk_text_window_type_get_type :: CUInt