{-# LINE 2 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
-- -*-haskell-*-
-----------------------------------------------------------------------------
-- Module : Graphics.UI.Gtk.WebKit.Download
-- Author : Cjacker Huang
-- Copyright : (c) 2009 Cjacker Huang <jzhuang@redflag-1 .com>
--
-- 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)
--
-- The history of a 'WebView'
-----------------------------------------------------------------------------

module Graphics.UI.Gtk.WebKit.WebBackForwardList (
-- * Types
  WebViewClass,
  WebBackForwardList,
  WebBackForwardListClass,

-- * Constructors
  webBackForwardListNewWithWebView,

-- * Methods
  webBackForwardListGoForward,
  webBackForwardListGoBack,
  webBackForwardListContainsItem,
  webBackForwardListGoToItem,
  webBackForwardListGetBackItem,
  webBackForwardListGetCurrentItem,
  webBackForwardListGetForwardItem,
  webBackForwardListGetNthItem,
  webBackForwardListGetBackLength,
  webBackForwardListGetForwardLength,
  webBackForwardListGetLimit,
  webBackForwardListSetLimit,
  webBackForwardListAddItem,
  webBackForwardListGetForwardListWithLimit,
  webBackForwardListGetBackListWithLimit,

) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.GError
import Graphics.UI.Gtk.Gdk.Events

import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.WebKit.Types
{-# LINE 64 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
import System.Glib.GObject
{-# LINE 65 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}


{-# LINE 67 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}


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

-- | Create an WebBackForwardList with a controlling WebView.
webBackForwardListNewWithWebView :: (WebViewClass webview) => webview -> IO WebBackForwardList
webBackForwardListNewWithWebView webview =
    wrapNewGObject mkWebBackForwardList $
      (\(WebView arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_new_with_web_view argPtr1)
{-# LINE 77 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
        (toWebView webview)

-- | Steps forward in the back forward list.
webBackForwardListGoForward ::
    WebBackForwardListClass self => self
 -> IO()
webBackForwardListGoForward webbackforwardlist =
    (\(WebBackForwardList arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_go_forward argPtr1) (toWebBackForwardList webbackforwardlist)

-- | Steps back in the back forward list.
webBackForwardListGoBack ::
    WebBackForwardListClass self => self
 -> IO()
webBackForwardListGoBack webbackforwardlist =
    (\(WebBackForwardList arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_go_back argPtr1) (toWebBackForwardList webbackforwardlist)

-- | Check if an history item in the back forward list.
webBackForwardListContainsItem ::
    (WebBackForwardListClass self, WebHistoryItemClass item) => self
 -> item
 -> IO Bool
webBackForwardListContainsItem webbackforwardlist webhistoryitem =
    liftM toBool $ (\(WebBackForwardList arg1) (WebHistoryItem arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_web_back_forward_list_contains_item argPtr1 argPtr2)
{-# LINE 100 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
      (toWebBackForwardList webbackforwardlist)
      (toWebHistoryItem webhistoryitem)

-- | Go to the specified history item in the back forward list.
webBackForwardListGoToItem ::
    (WebBackForwardListClass self,WebHistoryItemClass item) => self
 -> item
 -> IO()
webBackForwardListGoToItem webbackforwardlist webhistoryitem =
    (\(WebBackForwardList arg1) (WebHistoryItem arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_web_back_forward_list_go_to_item argPtr1 argPtr2)
{-# LINE 110 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
      (toWebBackForwardList webbackforwardlist)
      (toWebHistoryItem webhistoryitem)

-- | Return the history item that precedes the current history item.
webBackForwardListGetBackItem ::
    WebBackForwardListClass self => self
 -> IO (Maybe WebHistoryItem) -- ^ A 'WebHistoryItem' or @Nothing@
                              -- if there is nothing precedes the current item.
webBackForwardListGetBackItem webbackforwardlist =
    maybeNull (makeNewGObject mkWebHistoryItem) $
      (\(WebBackForwardList arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_get_back_item argPtr1)
{-# LINE 121 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
        (toWebBackForwardList webbackforwardlist)

-- | Return the current history item of the back forward list
webBackForwardListGetCurrentItem ::
    WebBackForwardListClass self => self
 -> IO WebHistoryItem
webBackForwardListGetCurrentItem webbackforwardlist =
    makeNewGObject mkWebHistoryItem $
      (\(WebBackForwardList arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_get_current_item argPtr1)
{-# LINE 130 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
      (toWebBackForwardList webbackforwardlist)

-- | Return the item that succeeds the current item

webBackForwardListGetForwardItem ::
    WebBackForwardListClass self => self
 -> IO (Maybe WebHistoryItem) -- ^ A 'WebHistoryItem' or @Nothing@
                              -- if there is nothing succeeds the current item.
webBackForwardListGetForwardItem webbackforwardlist =
    maybeNull (makeNewGObject mkWebHistoryItem) $
      (\(WebBackForwardList arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_get_forward_item argPtr1)
{-# LINE 141 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
      (toWebBackForwardList webbackforwardlist)

-- | Return the history item at a given index relative to the current item.
webBackForwardListGetNthItem ::
    WebBackForwardListClass self => self -- ^ @webbackforwardlist@ - a WebBackForwardList
 -> Int -- ^ @index@ - the index of the item
 -> IO WebHistoryItem
webBackForwardListGetNthItem webbackforwardlist index =
    makeNewGObject mkWebHistoryItem $
      (\(WebBackForwardList arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_get_nth_item argPtr1 arg2)
{-# LINE 151 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
      (toWebBackForwardList webbackforwardlist)
      (fromIntegral index)

-- | Return the number of items that preced the current item.
webBackForwardListGetBackLength ::
    WebBackForwardListClass self => self
 -> IO Int
webBackForwardListGetBackLength webbackforwardlist =
    liftM fromIntegral $
      (\(WebBackForwardList arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_get_back_length argPtr1)
{-# LINE 161 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
        (toWebBackForwardList webbackforwardlist)

-- | Return the number of items that succeed the current item.
webBackForwardListGetForwardLength ::
    WebBackForwardListClass self => self
 -> IO Int
webBackForwardListGetForwardLength webbackforwardlist =
    liftM fromIntegral $
      (\(WebBackForwardList arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_get_forward_length argPtr1)
{-# LINE 170 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
        (toWebBackForwardList webbackforwardlist)

-- | Return the maximum limit of the back forward list.
webBackForwardListGetLimit ::
    WebBackForwardListClass self => self
 -> IO Int
webBackForwardListGetLimit webbackforwardlist =
    liftM fromIntegral $
      (\(WebBackForwardList arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_get_limit argPtr1)
{-# LINE 179 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
        (toWebBackForwardList webbackforwardlist)

-- | Set the maximum limit of the back forward list.
--
-- if the back forward list exceeds its capacity,
-- items will be removed everytime a new item had been added.
--
webBackForwardListSetLimit ::
    WebBackForwardListClass self => self
 -> Int
 -> IO()
webBackForwardListSetLimit webbackforwardlist limit =
    (\(WebBackForwardList arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_set_limit argPtr1 arg2)
{-# LINE 192 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
      (toWebBackForwardList webbackforwardlist)
      (fromIntegral limit)

-- | Add the item to the back forward list.
webBackForwardListAddItem ::
    (WebBackForwardListClass self,WebHistoryItemClass item) => self
 -> item
 -> IO ()
webBackForwardListAddItem webbackforwardlist webhistoryitem =
    (\(WebBackForwardList arg1) (WebHistoryItem arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_web_back_forward_list_add_item argPtr1 argPtr2)
{-# LINE 202 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
      (toWebBackForwardList webbackforwardlist)
      (toWebHistoryItem webhistoryitem)

-- | Return a list of items that succeed the current item, limited by @limit@.
webBackForwardListGetForwardListWithLimit ::
    WebBackForwardListClass self => self
 -> Int -- ^ the number of items to retrieve
 -> IO [WebHistoryItem] -- ^ a 'List' of items succeeding the current item, limited by limit.
webBackForwardListGetForwardListWithLimit webbackforwardlist limit =
  (\(WebBackForwardList arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_get_forward_list_with_limit argPtr1 arg2)
{-# LINE 212 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
    (toWebBackForwardList webbackforwardlist)
    (fromIntegral limit)
    >>= fromGList
    >>= mapM (makeNewGObject mkWebHistoryItem . return)

-- | Return a list of items that preced the current item.
-- limited by limit.
webBackForwardListGetBackListWithLimit ::
    WebBackForwardListClass self => self
 -> Int -- ^ the number of items to retrieve
 -> IO [WebHistoryItem] -- ^ a 'List' of items preceding the current item, limited by limit
webBackForwardListGetBackListWithLimit webbackforwardlist limit =
  (\(WebBackForwardList arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_back_forward_list_get_back_list_with_limit argPtr1 arg2)
{-# LINE 225 "./Graphics/UI/Gtk/WebKit/WebBackForwardList.chs" #-}
    (toWebBackForwardList webbackforwardlist)
    (fromIntegral limit)
    >>= fromGList
    >>= mapM (makeNewGObject mkWebHistoryItem . return)

foreign import ccall safe "webkit_web_back_forward_list_new_with_web_view"
  webkit_web_back_forward_list_new_with_web_view :: ((Ptr WebView) -> (IO (Ptr WebBackForwardList)))

foreign import ccall safe "webkit_web_back_forward_list_go_forward"
  webkit_web_back_forward_list_go_forward :: ((Ptr WebBackForwardList) -> (IO ()))

foreign import ccall safe "webkit_web_back_forward_list_go_back"
  webkit_web_back_forward_list_go_back :: ((Ptr WebBackForwardList) -> (IO ()))

foreign import ccall safe "webkit_web_back_forward_list_contains_item"
  webkit_web_back_forward_list_contains_item :: ((Ptr WebBackForwardList) -> ((Ptr WebHistoryItem) -> (IO CInt)))

foreign import ccall safe "webkit_web_back_forward_list_go_to_item"
  webkit_web_back_forward_list_go_to_item :: ((Ptr WebBackForwardList) -> ((Ptr WebHistoryItem) -> (IO ())))

foreign import ccall safe "webkit_web_back_forward_list_get_back_item"
  webkit_web_back_forward_list_get_back_item :: ((Ptr WebBackForwardList) -> (IO (Ptr WebHistoryItem)))

foreign import ccall safe "webkit_web_back_forward_list_get_current_item"
  webkit_web_back_forward_list_get_current_item :: ((Ptr WebBackForwardList) -> (IO (Ptr WebHistoryItem)))

foreign import ccall safe "webkit_web_back_forward_list_get_forward_item"
  webkit_web_back_forward_list_get_forward_item :: ((Ptr WebBackForwardList) -> (IO (Ptr WebHistoryItem)))

foreign import ccall safe "webkit_web_back_forward_list_get_nth_item"
  webkit_web_back_forward_list_get_nth_item :: ((Ptr WebBackForwardList) -> (CInt -> (IO (Ptr WebHistoryItem))))

foreign import ccall safe "webkit_web_back_forward_list_get_back_length"
  webkit_web_back_forward_list_get_back_length :: ((Ptr WebBackForwardList) -> (IO CInt))

foreign import ccall safe "webkit_web_back_forward_list_get_forward_length"
  webkit_web_back_forward_list_get_forward_length :: ((Ptr WebBackForwardList) -> (IO CInt))

foreign import ccall safe "webkit_web_back_forward_list_get_limit"
  webkit_web_back_forward_list_get_limit :: ((Ptr WebBackForwardList) -> (IO CInt))

foreign import ccall safe "webkit_web_back_forward_list_set_limit"
  webkit_web_back_forward_list_set_limit :: ((Ptr WebBackForwardList) -> (CInt -> (IO ())))

foreign import ccall safe "webkit_web_back_forward_list_add_item"
  webkit_web_back_forward_list_add_item :: ((Ptr WebBackForwardList) -> ((Ptr WebHistoryItem) -> (IO ())))

foreign import ccall safe "webkit_web_back_forward_list_get_forward_list_with_limit"
  webkit_web_back_forward_list_get_forward_list_with_limit :: ((Ptr WebBackForwardList) -> (CInt -> (IO (Ptr ()))))

foreign import ccall safe "webkit_web_back_forward_list_get_back_list_with_limit"
  webkit_web_back_forward_list_get_back_list_with_limit :: ((Ptr WebBackForwardList) -> (CInt -> (IO (Ptr ()))))