{-# LINE 2 "./Graphics/UI/Gtk/Multiline/TextMark.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) TextMark TextBuffer
--
-- Author : Axel Simon
--
-- Created: 23 February 2002
--
-- Copyright (C) 2002-2005 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)
--
-- A position in the buffer preserved across buffer modifications
--
module Graphics.UI.Gtk.Multiline.TextMark (
-- * Detail
--
-- | You may wish to begin by reading the text widget conceptual overview
-- which gives an overview of all the objects and data types related to the
-- text widget and how they work together.
--
-- A 'TextMark' is like a bookmark in a text buffer; it preserves a position
-- in the text. You can convert the mark to an iterator using
-- 'textBufferGetIterAtMark'. Unlike
-- iterators, marks remain valid across buffer mutations, because their
-- behavior is defined when text is inserted or deleted. When text containing
-- a mark is deleted, the mark remains in the position originally occupied by
-- the deleted text. When text is inserted at a mark, a mark with left
-- gravity will be moved to the beginning of the newly-inserted text, and a
-- mark with right gravity will be moved to the end.
--
-- Marks can be deleted from the buffer at any time with
-- 'textBufferDeleteMark'. Once deleted
-- from the buffer, a mark is essentially useless.
--
-- Marks optionally have names; these can be convenient to avoid passing the
-- 'TextMark' object around.
--
-- Marks are typically created using the
-- 'textBufferCreateMark' function.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----TextMark
-- @

-- * Types
  TextMark,
  TextMarkClass,
  castToTextMark, gTypeTextMark,
  toTextMark,
  MarkName,

-- * Constructors

  textMarkNew,


-- * Methods
  textMarkSetVisible,
  textMarkGetVisible,
  textMarkGetDeleted,
  textMarkGetName,
  textMarkGetBuffer,
  textMarkGetLeftGravity,

-- * Attributes
  textMarkName,
  textMarkVisible,
  textMarkLeftGravity
  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Types
{-# LINE 95 "./Graphics/UI/Gtk/Multiline/TextMark.chs" #-}


{-# LINE 97 "./Graphics/UI/Gtk/Multiline/TextMark.chs" #-}

-- | The name of a mark.
type MarkName = DefaultGlibString

--------------------
-- Constructors


-- | Creates a text mark. Add it to a buffer using 'textBufferAddMark'. If
-- @name@ is @Nothing@, the mark is anonymous; otherwise, the mark can be retrieved by
-- this name
-- using 'textBufferGetMark'. If a mark has left gravity, and text is inserted
-- at the mark's current location, the mark will be moved to the left of the
-- newly-inserted text. If the mark has right gravity (@leftGravity@ =
-- @False@), the mark will end up on the right of newly-inserted text. The
-- standard left-to-right cursor is a mark with right gravity (when you type,
-- the cursor stays on the right side of the text you\'re typing).
--
-- * Available since Gtk+ version 2.12
--
textMarkNew ::
  Maybe MarkName -- ^ @markName@ - name for mark, or @Nothing@
 -> Bool -- ^ @leftGravity@ - whether the mark has left gravity
 -> IO TextMark
textMarkNew :: Maybe MarkName -> Bool -> IO TextMark
textMarkNew Maybe MarkName
markName Bool
leftGravity =
  (ForeignPtr TextMark -> TextMark, FinalizerPtr TextMark)
-> IO (Ptr TextMark) -> IO TextMark
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr TextMark -> TextMark, FinalizerPtr TextMark)
forall {a}. (ForeignPtr TextMark -> TextMark, FinalizerPtr a)
mkTextMark (IO (Ptr TextMark) -> IO TextMark)
-> IO (Ptr TextMark) -> IO TextMark
forall a b. (a -> b) -> a -> b
$
  (MarkName -> (Ptr CChar -> IO (Ptr TextMark)) -> IO (Ptr TextMark))
-> Maybe MarkName
-> (Ptr CChar -> IO (Ptr TextMark))
-> IO (Ptr TextMark)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith MarkName -> (Ptr CChar -> IO (Ptr TextMark)) -> IO (Ptr TextMark)
forall a. MarkName -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString Maybe MarkName
markName ((Ptr CChar -> IO (Ptr TextMark)) -> IO (Ptr TextMark))
-> (Ptr CChar -> IO (Ptr TextMark)) -> IO (Ptr TextMark)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
markNamePtr ->
  Ptr CChar -> CInt -> IO (Ptr TextMark)
gtk_text_mark_new
{-# LINE 125 "./Graphics/UI/Gtk/Multiline/TextMark.chs" #-}
    markNamePtr
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
leftGravity)


--------------------
-- Methods

-- | Sets the visibility of @mark@; the insertion point is normally visible,
-- i.e. you can see it as a vertical bar. Also, the text widget uses a visible
-- mark to indicate where a drop will occur when dragging-and-dropping text.
-- Most other marks are not visible. Marks are not visible by default.
--
textMarkSetVisible :: TextMarkClass self => self -> Bool -> IO ()
textMarkSetVisible :: forall self. TextMarkClass self => self -> Bool -> IO ()
textMarkSetVisible self
self Bool
setting =
  (\(TextMark ForeignPtr TextMark
arg1) CInt
arg2 -> ForeignPtr TextMark -> (Ptr TextMark -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TextMark
arg1 ((Ptr TextMark -> IO ()) -> IO ())
-> (Ptr TextMark -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TextMark
argPtr1 ->Ptr TextMark -> CInt -> IO ()
gtk_text_mark_set_visible Ptr TextMark
argPtr1 CInt
arg2)
{-# LINE 140 "./Graphics/UI/Gtk/Multiline/TextMark.chs" #-}
    (toTextMark self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)

-- | Returns @True@ if the mark is visible (i.e. a cursor is displayed for it)
--
textMarkGetVisible :: TextMarkClass self => self -> IO Bool
textMarkGetVisible :: forall self. TextMarkClass self => self -> IO Bool
textMarkGetVisible self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(TextMark ForeignPtr TextMark
arg1) -> ForeignPtr TextMark -> (Ptr TextMark -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TextMark
arg1 ((Ptr TextMark -> IO CInt) -> IO CInt)
-> (Ptr TextMark -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TextMark
argPtr1 ->Ptr TextMark -> IO CInt
gtk_text_mark_get_visible Ptr TextMark
argPtr1)
{-# LINE 149 "./Graphics/UI/Gtk/Multiline/TextMark.chs" #-}
    (toTextMark self)

-- | Returns @True@ if the mark has been removed from its buffer with
-- 'textBufferDeleteMark'. Marks can't
-- be used once deleted.
--
textMarkGetDeleted :: TextMarkClass self => self -> IO Bool
textMarkGetDeleted :: forall self. TextMarkClass self => self -> IO Bool
textMarkGetDeleted self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(TextMark ForeignPtr TextMark
arg1) -> ForeignPtr TextMark -> (Ptr TextMark -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TextMark
arg1 ((Ptr TextMark -> IO CInt) -> IO CInt)
-> (Ptr TextMark -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TextMark
argPtr1 ->Ptr TextMark -> IO CInt
gtk_text_mark_get_deleted Ptr TextMark
argPtr1)
{-# LINE 159 "./Graphics/UI/Gtk/Multiline/TextMark.chs" #-}
    (toTextMark self)

-- | Returns the mark name; returns @Nothing@ for anonymous marks.
--
textMarkGetName :: TextMarkClass self => self -> IO (Maybe MarkName)
textMarkGetName :: forall self. TextMarkClass self => self -> IO (Maybe MarkName)
textMarkGetName self
self =
  (\(TextMark ForeignPtr TextMark
arg1) -> ForeignPtr TextMark
-> (Ptr TextMark -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TextMark
arg1 ((Ptr TextMark -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr TextMark -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr TextMark
argPtr1 ->Ptr TextMark -> IO (Ptr CChar)
gtk_text_mark_get_name Ptr TextMark
argPtr1)
{-# LINE 166 "./Graphics/UI/Gtk/Multiline/TextMark.chs" #-}
    (toTextMark self)
  IO (Ptr CChar)
-> (Ptr CChar -> IO (Maybe MarkName)) -> IO (Maybe MarkName)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar -> IO MarkName) -> Ptr CChar -> IO (Maybe MarkName)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO MarkName
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString

-- | Gets the buffer this mark is located inside, or @Nothing@ if the mark is
-- deleted.
--
textMarkGetBuffer :: TextMarkClass self => self -> IO (Maybe TextBuffer)
textMarkGetBuffer :: forall self. TextMarkClass self => self -> IO (Maybe TextBuffer)
textMarkGetBuffer self
self =
  (IO (Ptr TextBuffer) -> IO TextBuffer)
-> IO (Ptr TextBuffer) -> IO (Maybe TextBuffer)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr TextBuffer -> TextBuffer, FinalizerPtr TextBuffer)
-> IO (Ptr TextBuffer) -> IO TextBuffer
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr TextBuffer -> TextBuffer, FinalizerPtr TextBuffer)
forall {a}. (ForeignPtr TextBuffer -> TextBuffer, FinalizerPtr a)
mkTextBuffer) (IO (Ptr TextBuffer) -> IO (Maybe TextBuffer))
-> IO (Ptr TextBuffer) -> IO (Maybe TextBuffer)
forall a b. (a -> b) -> a -> b
$
  (\(TextMark ForeignPtr TextMark
arg1) -> ForeignPtr TextMark
-> (Ptr TextMark -> IO (Ptr TextBuffer)) -> IO (Ptr TextBuffer)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TextMark
arg1 ((Ptr TextMark -> IO (Ptr TextBuffer)) -> IO (Ptr TextBuffer))
-> (Ptr TextMark -> IO (Ptr TextBuffer)) -> IO (Ptr TextBuffer)
forall a b. (a -> b) -> a -> b
$ \Ptr TextMark
argPtr1 ->Ptr TextMark -> IO (Ptr TextBuffer)
gtk_text_mark_get_buffer Ptr TextMark
argPtr1)
{-# LINE 176 "./Graphics/UI/Gtk/Multiline/TextMark.chs" #-}
    (toTextMark self)

-- | Determines whether the mark has left gravity.
--
-- The name is misleading as Arabic, Hebrew and some other languages have the
-- beginning of a line towards the right.
--
textMarkGetLeftGravity :: TextMarkClass self => self -> IO Bool
textMarkGetLeftGravity :: forall self. TextMarkClass self => self -> IO Bool
textMarkGetLeftGravity self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(TextMark ForeignPtr TextMark
arg1) -> ForeignPtr TextMark -> (Ptr TextMark -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TextMark
arg1 ((Ptr TextMark -> IO CInt) -> IO CInt)
-> (Ptr TextMark -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TextMark
argPtr1 ->Ptr TextMark -> IO CInt
gtk_text_mark_get_left_gravity Ptr TextMark
argPtr1)
{-# LINE 187 "./Graphics/UI/Gtk/Multiline/TextMark.chs" #-}
    (toTextMark self)

--------------------
-- Attributes

-- | Retreives the name of a mark.
--
textMarkName :: TextMarkClass self => ReadAttr self (Maybe MarkName)
textMarkName :: forall self. TextMarkClass self => ReadAttr self (Maybe MarkName)
textMarkName = String -> ReadAttr self (Maybe MarkName)
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> ReadAttr gobj (Maybe string)
readAttrFromMaybeStringProperty String
"name"

-- | The \'visible\' property. See 'textMarkGetVisible' and 'textMarkSetVisible'
--
textMarkVisible :: TextMarkClass self => Attr self Bool
textMarkVisible :: forall self. TextMarkClass self => Attr self Bool
textMarkVisible = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Bool
forall self. TextMarkClass self => self -> IO Bool
textMarkGetVisible
  self -> Bool -> IO ()
forall self. TextMarkClass self => self -> Bool -> IO ()
textMarkSetVisible

-- | Determines whether the mark keeps to the left when text is inserted at its position.
--
textMarkLeftGravity :: TextMarkClass self => ReadAttr self Bool
textMarkLeftGravity :: forall self. TextMarkClass self => ReadAttr self Bool
textMarkLeftGravity = String -> ReadAttr self Bool
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Bool
readAttrFromBoolProperty String
"left-gravity"

foreign import ccall safe "gtk_text_mark_new"
  gtk_text_mark_new :: ((Ptr CChar) -> (CInt -> (IO (Ptr TextMark))))

foreign import ccall unsafe "gtk_text_mark_set_visible"
  gtk_text_mark_set_visible :: ((Ptr TextMark) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_text_mark_get_visible"
  gtk_text_mark_get_visible :: ((Ptr TextMark) -> (IO CInt))

foreign import ccall unsafe "gtk_text_mark_get_deleted"
  gtk_text_mark_get_deleted :: ((Ptr TextMark) -> (IO CInt))

foreign import ccall unsafe "gtk_text_mark_get_name"
  gtk_text_mark_get_name :: ((Ptr TextMark) -> (IO (Ptr CChar)))

foreign import ccall unsafe "gtk_text_mark_get_buffer"
  gtk_text_mark_get_buffer :: ((Ptr TextMark) -> (IO (Ptr TextBuffer)))

foreign import ccall unsafe "gtk_text_mark_get_left_gravity"
  gtk_text_mark_get_left_gravity :: ((Ptr TextMark) -> (IO CInt))