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


{-# LINE 1 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
module Graphics.UI.Gtk.WebKit.DOM.HTMLOptionElement
       (htmlOptionElementSetDisabled, htmlOptionElementGetDisabled,
        htmlOptionElementGetForm, htmlOptionElementSetLabel,
        htmlOptionElementGetLabel, htmlOptionElementSetDefaultSelected,
        htmlOptionElementGetDefaultSelected, htmlOptionElementSetSelected,
        htmlOptionElementGetSelected, htmlOptionElementSetValue,
        htmlOptionElementGetValue, htmlOptionElementGetText,
        htmlOptionElementGetIndex)
       where
import System.Glib.FFI
import System.Glib.UTFString
import Control.Applicative
import Graphics.UI.Gtk.WebKit.Types
{-# LINE 13 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
import System.Glib.GError
import Graphics.UI.Gtk.WebKit.DOM.EventM
 
htmlOptionElementSetDisabled ::
                             (HTMLOptionElementClass self) => self -> Bool -> IO ()
htmlOptionElementSetDisabled self val
  = (\(HTMLOptionElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_set_disabled argPtr1 arg2)
{-# LINE 20 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
      (toHTMLOptionElement self)
      (fromBool val)
 
htmlOptionElementGetDisabled ::
                             (HTMLOptionElementClass self) => self -> IO Bool
htmlOptionElementGetDisabled self
  = toBool <$>
      ((\(HTMLOptionElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_get_disabled argPtr1)
{-# LINE 28 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
         (toHTMLOptionElement self))
 
htmlOptionElementGetForm ::
                         (HTMLOptionElementClass self) => self -> IO (Maybe HTMLFormElement)
htmlOptionElementGetForm self
  = maybeNull (makeNewGObject mkHTMLFormElement)
      ((\(HTMLOptionElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_get_form argPtr1)
{-# LINE 35 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
         (toHTMLOptionElement self))
 
htmlOptionElementSetLabel ::
                          (HTMLOptionElementClass self) => self -> String -> IO ()
htmlOptionElementSetLabel self val
  = withUTFString val $
      \ valPtr ->
        (\(HTMLOptionElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_set_label argPtr1 arg2)
{-# LINE 43 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
          (toHTMLOptionElement self)
          valPtr
 
htmlOptionElementGetLabel ::
                          (HTMLOptionElementClass self) => self -> IO String
htmlOptionElementGetLabel self
  = ((\(HTMLOptionElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_get_label argPtr1)
{-# LINE 50 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
       (toHTMLOptionElement self))
      >>=
      readUTFString
 
htmlOptionElementSetDefaultSelected ::
                                    (HTMLOptionElementClass self) => self -> Bool -> IO ()
htmlOptionElementSetDefaultSelected self val
  = (\(HTMLOptionElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_set_default_selected argPtr1 arg2)
{-# LINE 58 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
      (toHTMLOptionElement self)
      (fromBool val)
 
htmlOptionElementGetDefaultSelected ::
                                    (HTMLOptionElementClass self) => self -> IO Bool
htmlOptionElementGetDefaultSelected self
  = toBool <$>
      ((\(HTMLOptionElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_get_default_selected argPtr1)
{-# LINE 66 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
         (toHTMLOptionElement self))
 
htmlOptionElementSetSelected ::
                             (HTMLOptionElementClass self) => self -> Bool -> IO ()
htmlOptionElementSetSelected self val
  = (\(HTMLOptionElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_set_selected argPtr1 arg2)
{-# LINE 72 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
      (toHTMLOptionElement self)
      (fromBool val)
 
htmlOptionElementGetSelected ::
                             (HTMLOptionElementClass self) => self -> IO Bool
htmlOptionElementGetSelected self
  = toBool <$>
      ((\(HTMLOptionElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_get_selected argPtr1)
{-# LINE 80 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
         (toHTMLOptionElement self))
 
htmlOptionElementSetValue ::
                          (HTMLOptionElementClass self) => self -> String -> IO ()
htmlOptionElementSetValue self val
  = withUTFString val $
      \ valPtr ->
        (\(HTMLOptionElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_set_value argPtr1 arg2)
{-# LINE 88 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
          (toHTMLOptionElement self)
          valPtr
 
htmlOptionElementGetValue ::
                          (HTMLOptionElementClass self) => self -> IO String
htmlOptionElementGetValue self
  = ((\(HTMLOptionElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_get_value argPtr1)
{-# LINE 95 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
       (toHTMLOptionElement self))
      >>=
      readUTFString
 
htmlOptionElementGetText ::
                         (HTMLOptionElementClass self) => self -> IO String
htmlOptionElementGetText self
  = ((\(HTMLOptionElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_get_text argPtr1)
{-# LINE 103 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
       (toHTMLOptionElement self))
      >>=
      readUTFString
 
htmlOptionElementGetIndex ::
                          (HTMLOptionElementClass self) => self -> IO Int
htmlOptionElementGetIndex self
  = fromIntegral <$>
      ((\(HTMLOptionElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_option_element_get_index argPtr1)
{-# LINE 112 "./Graphics/UI/Gtk/WebKit/DOM/HTMLOptionElement.chs" #-}
         (toHTMLOptionElement self))

foreign import ccall safe "webkit_dom_html_option_element_set_disabled"
  webkit_dom_html_option_element_set_disabled :: ((Ptr HTMLOptionElement) -> (CInt -> (IO ())))

foreign import ccall safe "webkit_dom_html_option_element_get_disabled"
  webkit_dom_html_option_element_get_disabled :: ((Ptr HTMLOptionElement) -> (IO CInt))

foreign import ccall safe "webkit_dom_html_option_element_get_form"
  webkit_dom_html_option_element_get_form :: ((Ptr HTMLOptionElement) -> (IO (Ptr HTMLFormElement)))

foreign import ccall safe "webkit_dom_html_option_element_set_label"
  webkit_dom_html_option_element_set_label :: ((Ptr HTMLOptionElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "webkit_dom_html_option_element_get_label"
  webkit_dom_html_option_element_get_label :: ((Ptr HTMLOptionElement) -> (IO (Ptr CChar)))

foreign import ccall safe "webkit_dom_html_option_element_set_default_selected"
  webkit_dom_html_option_element_set_default_selected :: ((Ptr HTMLOptionElement) -> (CInt -> (IO ())))

foreign import ccall safe "webkit_dom_html_option_element_get_default_selected"
  webkit_dom_html_option_element_get_default_selected :: ((Ptr HTMLOptionElement) -> (IO CInt))

foreign import ccall safe "webkit_dom_html_option_element_set_selected"
  webkit_dom_html_option_element_set_selected :: ((Ptr HTMLOptionElement) -> (CInt -> (IO ())))

foreign import ccall safe "webkit_dom_html_option_element_get_selected"
  webkit_dom_html_option_element_get_selected :: ((Ptr HTMLOptionElement) -> (IO CInt))

foreign import ccall safe "webkit_dom_html_option_element_set_value"
  webkit_dom_html_option_element_set_value :: ((Ptr HTMLOptionElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "webkit_dom_html_option_element_get_value"
  webkit_dom_html_option_element_get_value :: ((Ptr HTMLOptionElement) -> (IO (Ptr CChar)))

foreign import ccall safe "webkit_dom_html_option_element_get_text"
  webkit_dom_html_option_element_get_text :: ((Ptr HTMLOptionElement) -> (IO (Ptr CChar)))

foreign import ccall safe "webkit_dom_html_option_element_get_index"
  webkit_dom_html_option_element_get_index :: ((Ptr HTMLOptionElement) -> (IO CLong))