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


{-# LINE 1 "./Graphics/UI/Gtk/WebKit/DOM/DOMTokenList.chs" #-}
module Graphics.UI.Gtk.WebKit.DOM.DOMTokenList
       (domTokenListItem, domTokenListContains, domTokenListAdd,
        domTokenListRemove, domTokenListToggle, domTokenListGetLength,
        DOMTokenList, DOMTokenListClass, castToDOMTokenList,
        gTypeDOMTokenList, toDOMTokenList)
       where
import System.Glib.FFI
import System.Glib.UTFString
import Control.Applicative
import Graphics.UI.Gtk.WebKit.Types
{-# LINE 10 "./Graphics/UI/Gtk/WebKit/DOM/DOMTokenList.chs" #-}
import System.Glib.GError
import Graphics.UI.Gtk.WebKit.DOM.EventM

domTokenListItem ::
                 (DOMTokenListClass self, GlibString string) =>
                   self -> Word -> IO string
domTokenListItem self index
  = ((\(DOMTokenList arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_token_list_item argPtr1 arg2) (toDOMTokenList self)
       (fromIntegral index))
      >>=
      readUTFString

domTokenListContains ::
                     (DOMTokenListClass self, GlibString string) =>
                       self -> string -> IO Bool
domTokenListContains self token
  = toBool <$>
      (propagateGError $
         \ errorPtr_ ->
           withUTFString token $
             \ tokenPtr ->
               (\(DOMTokenList arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_token_list_contains argPtr1 arg2 arg3) (toDOMTokenList self)
                 tokenPtr
             errorPtr_)

domTokenListAdd ::
                (DOMTokenListClass self, GlibString string) => self -> string -> IO ()
domTokenListAdd self token
  = propagateGError $
      \ errorPtr_ ->
        withUTFString token $
          \ tokenPtr ->
            (\(DOMTokenList arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_token_list_add argPtr1 arg2 arg3) (toDOMTokenList self)
              tokenPtr
          errorPtr_

domTokenListRemove ::
                   (DOMTokenListClass self, GlibString string) => self -> string -> IO ()
domTokenListRemove self token
  = propagateGError $
      \ errorPtr_ ->
        withUTFString token $
          \ tokenPtr ->
            (\(DOMTokenList arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_token_list_remove argPtr1 arg2 arg3) (toDOMTokenList self)
              tokenPtr
          errorPtr_

domTokenListToggle ::
                   (DOMTokenListClass self, GlibString string) =>
                     self -> string -> Bool -> IO Bool
domTokenListToggle self token force = toBool <$> (propagateGError $ \errorPtr_ -> withUTFString token $ \tokenPtr ->
    (\(DOMTokenList arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_token_list_toggle argPtr1 arg2 arg3 arg4) (toDOMTokenList self) tokenPtr (fromBool force) errorPtr_)

domTokenListGetLength ::
                      (DOMTokenListClass self) => self -> IO Word
domTokenListGetLength self
  = fromIntegral <$>
      ((\(DOMTokenList arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_token_list_get_length argPtr1)
{-# LINE 82 "./Graphics/UI/Gtk/WebKit/DOM/DOMTokenList.chs" #-}
         (toDOMTokenList self))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/DOMTokenList.h webkit_dom_dom_token_list_item"
  webkit_dom_dom_token_list_item :: ((Ptr DOMTokenList) -> (CULong -> (IO (Ptr CChar))))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/DOMTokenList.h webkit_dom_dom_token_list_contains"
  webkit_dom_dom_token_list_contains :: ((Ptr DOMTokenList) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO CInt))))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/DOMTokenList.h webkit_dom_dom_token_list_add"
  webkit_dom_dom_token_list_add :: ((Ptr DOMTokenList) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO ()))))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/DOMTokenList.h webkit_dom_dom_token_list_remove"
  webkit_dom_dom_token_list_remove :: ((Ptr DOMTokenList) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO ()))))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/DOMTokenList.h webkit_dom_dom_token_list_toggle"
  webkit_dom_dom_token_list_toggle :: ((Ptr DOMTokenList) -> ((Ptr CChar) -> (CInt -> ((Ptr (Ptr ())) -> (IO CInt)))))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/DOMTokenList.h webkit_dom_dom_token_list_get_length"
  webkit_dom_dom_token_list_get_length :: ((Ptr DOMTokenList) -> (IO CULong))