-- GENERATED by C->Haskell Compiler, version 0.13.13 (gtk2hs branch) "Bin IO", 27 May 2012 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
module Graphics.UI.Gtk.WebKit.DOM.Selection(
collapse,
collapseToEnd,
collapseToStart,
deleteFromDocument,
containsNode,
selectAllChildren,
extend,
getRangeAt,
removeAllRanges,
addRange,
modify,
setBaseAndExtent,
setPosition,
empty,
getAnchorNode,
getAnchorOffset,
getFocusNode,
getFocusOffset,
getIsCollapsed,
getRangeCount,
getBaseNode,
getBaseOffset,
getExtentNode,
getExtentOffset,
Selection,
castToSelection,
gTypeSelection,
SelectionClass,
toSelection,
) where
import Prelude hiding (drop, error, print)
import Data.Typeable (Typeable)
import Foreign.Marshal (maybePeek, maybeWith)
import System.Glib.FFI (maybeNull, withForeignPtr, nullForeignPtr, Ptr, nullPtr, castPtr, Word, Int64, Word64, CChar(..), CInt(..), CUInt(..), CLong(..), CULong(..), CLLong(..), CULLong(..), CShort(..), CUShort(..), CFloat(..), CDouble(..), toBool, fromBool)
import System.Glib.UTFString (GlibString(..), readUTFString)
import Control.Applicative ((<$>))
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..))
import System.Glib.GError
import Graphics.UI.Gtk.WebKit.DOM.EventTargetClosures
import Graphics.UI.Gtk.WebKit.DOM.EventM
import Graphics.UI.Gtk.WebKit.Types
{-# LINE 43 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
import Graphics.UI.Gtk.WebKit.DOM.Enums

 
collapse ::
         (MonadIO m, SelectionClass self, NodeClass node) =>
           self -> Maybe node -> Int -> m ()
collapse self node index
  = liftIO
      (propagateGError $
         \ errorPtr_ ->
           (\(Selection arg1) (Node arg2) arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_dom_dom_selection_collapse argPtr1 argPtr2 arg3 arg4) (toSelection self)
             (maybe (Node nullForeignPtr) toNode node)
             (fromIntegral index)
             errorPtr_)
 
collapseToEnd :: (MonadIO m, SelectionClass self) => self -> m ()
collapseToEnd self
  = liftIO
      (propagateGError $
         \ errorPtr_ ->
           (\(Selection arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_collapse_to_end argPtr1 arg2)
{-# LINE 64 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
             (toSelection self)
             errorPtr_)
 
collapseToStart :: (MonadIO m, SelectionClass self) => self -> m ()
collapseToStart self
  = liftIO
      (propagateGError $
         \ errorPtr_ ->
           (\(Selection arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_collapse_to_start argPtr1 arg2)
{-# LINE 73 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
             (toSelection self)
             errorPtr_)
 
deleteFromDocument ::
                   (MonadIO m, SelectionClass self) => self -> m ()
deleteFromDocument self
  = liftIO
      ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_delete_from_document argPtr1)
{-# LINE 81 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
         (toSelection self))
 
containsNode ::
             (MonadIO m, SelectionClass self, NodeClass node) =>
               self -> Maybe node -> Bool -> m Bool
containsNode self node allowPartial
  = liftIO
      (toBool <$>
         ((\(Selection arg1) (Node arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_dom_dom_selection_contains_node argPtr1 argPtr2 arg3)
{-# LINE 90 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)
            (maybe (Node nullForeignPtr) toNode node)
            (fromBool allowPartial)))
 
selectAllChildren ::
                  (MonadIO m, SelectionClass self, NodeClass node) =>
                    self -> Maybe node -> m ()
selectAllChildren self node
  = liftIO
      (propagateGError $
         \ errorPtr_ ->
           (\(Selection arg1) (Node arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_dom_dom_selection_select_all_children argPtr1 argPtr2 arg3)
{-# LINE 102 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
             (toSelection self)
             (maybe (Node nullForeignPtr) toNode node)
             errorPtr_)
 
extend ::
       (MonadIO m, SelectionClass self, NodeClass node) =>
         self -> Maybe node -> Int -> m ()
extend self node offset
  = liftIO
      (propagateGError $
         \ errorPtr_ ->
           (\(Selection arg1) (Node arg2) arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_dom_dom_selection_extend argPtr1 argPtr2 arg3 arg4) (toSelection self)
             (maybe (Node nullForeignPtr) toNode node)
             (fromIntegral offset)
             errorPtr_)
 
getRangeAt ::
           (MonadIO m, SelectionClass self) => self -> Int -> m (Maybe Range)
getRangeAt self index
  = liftIO
      (maybeNull (makeNewGObject mkRange)
         (propagateGError $
            \ errorPtr_ ->
              (\(Selection arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_range_at argPtr1 arg2 arg3) (toSelection self)
                (fromIntegral index)
                errorPtr_))
 
removeAllRanges :: (MonadIO m, SelectionClass self) => self -> m ()
removeAllRanges self
  = liftIO
      ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_remove_all_ranges argPtr1)
{-# LINE 133 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
         (toSelection self))
 
addRange ::
         (MonadIO m, SelectionClass self, RangeClass range) =>
           self -> Maybe range -> m ()
addRange self range
  = liftIO
      ((\(Selection arg1) (Range arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_dom_dom_selection_add_range argPtr1 argPtr2) (toSelection self)
         (maybe (Range nullForeignPtr) toRange range))
 
modify ::
       (MonadIO m, SelectionClass self, GlibString string) =>
         self -> string -> string -> string -> m ()
modify self alter direction granularity
  = liftIO
      (withUTFString granularity $
         \ granularityPtr ->
           withUTFString direction $
             \ directionPtr ->
               withUTFString alter $
                 \ alterPtr ->
                   (\(Selection arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_modify argPtr1 arg2 arg3 arg4) (toSelection self)
                     alterPtr
                 directionPtr
             granularityPtr)
 
setBaseAndExtent ::
                 (MonadIO m, SelectionClass self, NodeClass baseNode,
                  NodeClass extentNode) =>
                   self -> Maybe baseNode -> Int -> Maybe extentNode -> Int -> m ()
setBaseAndExtent self baseNode baseOffset extentNode extentOffset
  = liftIO
      (propagateGError $
         \ errorPtr_ ->
           (\(Selection arg1) (Node arg2) arg3 (Node arg4) arg5 arg6 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg4 $ \argPtr4 ->webkit_dom_dom_selection_set_base_and_extent argPtr1 argPtr2 arg3 argPtr4 arg5 arg6)
{-# LINE 168 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
             (toSelection self)
             (maybe (Node nullForeignPtr) toNode baseNode)
             (fromIntegral baseOffset)
             (maybe (Node nullForeignPtr) toNode extentNode)
             (fromIntegral extentOffset)
             errorPtr_)
 
setPosition ::
            (MonadIO m, SelectionClass self, NodeClass node) =>
              self -> Maybe node -> Int -> m ()
setPosition self node offset
  = liftIO
      (propagateGError $
         \ errorPtr_ ->
           (\(Selection arg1) (Node arg2) arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_dom_dom_selection_set_position argPtr1 argPtr2 arg3 arg4) (toSelection self)
             (maybe (Node nullForeignPtr) toNode node)
             (fromIntegral offset)
             errorPtr_)
 
empty :: (MonadIO m, SelectionClass self) => self -> m ()
empty self
  = liftIO
      ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_empty argPtr1) (toSelection self))
 
getAnchorNode ::
              (MonadIO m, SelectionClass self) => self -> m (Maybe Node)
getAnchorNode self
  = liftIO
      (maybeNull (makeNewGObject mkNode)
         ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_anchor_node argPtr1)
{-# LINE 198 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)))
 
getAnchorOffset ::
                (MonadIO m, SelectionClass self) => self -> m Int
getAnchorOffset self
  = liftIO
      (fromIntegral <$>
         ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_anchor_offset argPtr1)
{-# LINE 206 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)))
 
getFocusNode ::
             (MonadIO m, SelectionClass self) => self -> m (Maybe Node)
getFocusNode self
  = liftIO
      (maybeNull (makeNewGObject mkNode)
         ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_focus_node argPtr1)
{-# LINE 214 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)))
 
getFocusOffset :: (MonadIO m, SelectionClass self) => self -> m Int
getFocusOffset self
  = liftIO
      (fromIntegral <$>
         ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_focus_offset argPtr1)
{-# LINE 221 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)))
 
getIsCollapsed ::
               (MonadIO m, SelectionClass self) => self -> m Bool
getIsCollapsed self
  = liftIO
      (toBool <$>
         ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_is_collapsed argPtr1)
{-# LINE 229 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)))
 
getRangeCount :: (MonadIO m, SelectionClass self) => self -> m Int
getRangeCount self
  = liftIO
      (fromIntegral <$>
         ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_range_count argPtr1)
{-# LINE 236 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)))
 
getBaseNode ::
            (MonadIO m, SelectionClass self) => self -> m (Maybe Node)
getBaseNode self
  = liftIO
      (maybeNull (makeNewGObject mkNode)
         ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_base_node argPtr1)
{-# LINE 244 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)))
 
getBaseOffset :: (MonadIO m, SelectionClass self) => self -> m Int
getBaseOffset self
  = liftIO
      (fromIntegral <$>
         ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_base_offset argPtr1)
{-# LINE 251 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)))
 
getExtentNode ::
              (MonadIO m, SelectionClass self) => self -> m (Maybe Node)
getExtentNode self
  = liftIO
      (maybeNull (makeNewGObject mkNode)
         ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_extent_node argPtr1)
{-# LINE 259 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)))
 
getExtentOffset ::
                (MonadIO m, SelectionClass self) => self -> m Int
getExtentOffset self
  = liftIO
      (fromIntegral <$>
         ((\(Selection arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_selection_get_extent_offset argPtr1)
{-# LINE 267 "./Graphics/UI/Gtk/WebKit/DOM/Selection.chs" #-}
            (toSelection self)))

foreign import ccall safe "webkit_dom_dom_selection_collapse"
  webkit_dom_dom_selection_collapse :: ((Ptr Selection) -> ((Ptr Node) -> (CLong -> ((Ptr (Ptr ())) -> (IO ())))))

foreign import ccall safe "webkit_dom_dom_selection_collapse_to_end"
  webkit_dom_dom_selection_collapse_to_end :: ((Ptr Selection) -> ((Ptr (Ptr ())) -> (IO ())))

foreign import ccall safe "webkit_dom_dom_selection_collapse_to_start"
  webkit_dom_dom_selection_collapse_to_start :: ((Ptr Selection) -> ((Ptr (Ptr ())) -> (IO ())))

foreign import ccall safe "webkit_dom_dom_selection_delete_from_document"
  webkit_dom_dom_selection_delete_from_document :: ((Ptr Selection) -> (IO ()))

foreign import ccall safe "webkit_dom_dom_selection_contains_node"
  webkit_dom_dom_selection_contains_node :: ((Ptr Selection) -> ((Ptr Node) -> (CInt -> (IO CInt))))

foreign import ccall safe "webkit_dom_dom_selection_select_all_children"
  webkit_dom_dom_selection_select_all_children :: ((Ptr Selection) -> ((Ptr Node) -> ((Ptr (Ptr ())) -> (IO ()))))

foreign import ccall safe "webkit_dom_dom_selection_extend"
  webkit_dom_dom_selection_extend :: ((Ptr Selection) -> ((Ptr Node) -> (CLong -> ((Ptr (Ptr ())) -> (IO ())))))

foreign import ccall safe "webkit_dom_dom_selection_get_range_at"
  webkit_dom_dom_selection_get_range_at :: ((Ptr Selection) -> (CLong -> ((Ptr (Ptr ())) -> (IO (Ptr Range)))))

foreign import ccall safe "webkit_dom_dom_selection_remove_all_ranges"
  webkit_dom_dom_selection_remove_all_ranges :: ((Ptr Selection) -> (IO ()))

foreign import ccall safe "webkit_dom_dom_selection_add_range"
  webkit_dom_dom_selection_add_range :: ((Ptr Selection) -> ((Ptr Range) -> (IO ())))

foreign import ccall safe "webkit_dom_dom_selection_modify"
  webkit_dom_dom_selection_modify :: ((Ptr Selection) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO ())))))

foreign import ccall safe "webkit_dom_dom_selection_set_base_and_extent"
  webkit_dom_dom_selection_set_base_and_extent :: ((Ptr Selection) -> ((Ptr Node) -> (CLong -> ((Ptr Node) -> (CLong -> ((Ptr (Ptr ())) -> (IO ())))))))

foreign import ccall safe "webkit_dom_dom_selection_set_position"
  webkit_dom_dom_selection_set_position :: ((Ptr Selection) -> ((Ptr Node) -> (CLong -> ((Ptr (Ptr ())) -> (IO ())))))

foreign import ccall safe "webkit_dom_dom_selection_empty"
  webkit_dom_dom_selection_empty :: ((Ptr Selection) -> (IO ()))

foreign import ccall safe "webkit_dom_dom_selection_get_anchor_node"
  webkit_dom_dom_selection_get_anchor_node :: ((Ptr Selection) -> (IO (Ptr Node)))

foreign import ccall safe "webkit_dom_dom_selection_get_anchor_offset"
  webkit_dom_dom_selection_get_anchor_offset :: ((Ptr Selection) -> (IO CLong))

foreign import ccall safe "webkit_dom_dom_selection_get_focus_node"
  webkit_dom_dom_selection_get_focus_node :: ((Ptr Selection) -> (IO (Ptr Node)))

foreign import ccall safe "webkit_dom_dom_selection_get_focus_offset"
  webkit_dom_dom_selection_get_focus_offset :: ((Ptr Selection) -> (IO CLong))

foreign import ccall safe "webkit_dom_dom_selection_get_is_collapsed"
  webkit_dom_dom_selection_get_is_collapsed :: ((Ptr Selection) -> (IO CInt))

foreign import ccall safe "webkit_dom_dom_selection_get_range_count"
  webkit_dom_dom_selection_get_range_count :: ((Ptr Selection) -> (IO CLong))

foreign import ccall safe "webkit_dom_dom_selection_get_base_node"
  webkit_dom_dom_selection_get_base_node :: ((Ptr Selection) -> (IO (Ptr Node)))

foreign import ccall safe "webkit_dom_dom_selection_get_base_offset"
  webkit_dom_dom_selection_get_base_offset :: ((Ptr Selection) -> (IO CLong))

foreign import ccall safe "webkit_dom_dom_selection_get_extent_node"
  webkit_dom_dom_selection_get_extent_node :: ((Ptr Selection) -> (IO (Ptr Node)))

foreign import ccall safe "webkit_dom_dom_selection_get_extent_offset"
  webkit_dom_dom_selection_get_extent_offset :: ((Ptr Selection) -> (IO CLong))