-- GENERATED by C->Haskell Compiler, version 0.27.1 Eternal Sunshine, 29 November 2015 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}
{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.Browser
    (
     -- * Constructor
     browserNew,
     browserCustom
     -- * Hierarchy
     --
     -- $hierarchy

     -- * Functions
     --
     -- $functions
    )
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp






import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum)
import Foreign.C.Types
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Utils
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Graphics.UI.FLTK.LowLevel.Dispatch
import Graphics.UI.FLTK.LowLevel.Widget

browserNew' :: (Int) -> (Int) -> (Int) -> (Int) -> IO ((Ptr ()))
browserNew' a1 a2 a3 a4 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  browserNew''_ a1' a2' a3' a4' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 30 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

browserNewWithLabel' :: (Int) -> (Int) -> (Int) -> (Int) -> (String) -> IO ((Ptr ()))
browserNewWithLabel' a1 a2 a3 a4 a5 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = unsafeToCString a5} in 
  browserNewWithLabel''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 31 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

overriddenBrowserNewWithLabel' :: (Int) -> (Int) -> (Int) -> (Int) -> (String) -> (Ptr ()) -> IO ((Ptr ()))
overriddenBrowserNewWithLabel' a1 a2 a3 a4 a5 a6 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = unsafeToCString a5} in 
  let {a6' = id a6} in 
  overriddenBrowserNewWithLabel''_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 32 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

overriddenBrowserNew' :: (Int) -> (Int) -> (Int) -> (Int) -> (Ptr ()) -> IO ((Ptr ()))
overriddenBrowserNew' a1 a2 a3 a4 a5 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = id a5} in 
  overriddenBrowserNew''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 33 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

browserCustom :: Rectangle -> Maybe String -> Maybe (Ref Browser -> IO ()) -> Maybe (CustomWidgetFuncs Browser) -> IO (Ref Browser)
browserCustom rectangle l' draw' funcs' =
  widgetMaker
    rectangle
    l'
    draw'
    funcs'
    browserNew'
    browserNewWithLabel'
    overriddenBrowserNew'
    overriddenBrowserNewWithLabel'

browserNew :: Rectangle -> Maybe String -> IO (Ref Browser)
browserNew rectangle l' =
    let (x_pos, y_pos, width, height) = fromRectangle rectangle
    in case l' of
        Nothing -> browserNew' x_pos y_pos width height >>=
                             toRef
        Just l -> browserNewWithLabel' x_pos y_pos width height l >>=
                             toRef


browserHandle' :: (Ptr ()) -> (CInt) -> IO ((Int))
browserHandle' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  browserHandle''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 56 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Event -> IO Int)) => Op (Handle ()) Browser orig impl where
  runOp _ _ browser event = withRef browser (\p -> browserHandle' p (fromIntegral . fromEnum $ event))
browserDestroy' :: (Ptr ()) -> IO ()
browserDestroy' a1 =
  let {a1' = id a1} in 
  browserDestroy''_ a1' >>
  return ()

{-# LINE 59 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (IO ())) => Op (Destroy ()) Browser orig impl where
  runOp _ _ browser = swapRef browser $ \browserPtr -> do
    browserDestroy' browserPtr
    return nullPtr
remove' :: (Ptr ()) -> (Int) -> IO ()
remove' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  remove''_ a1' a2' >>
  return ()

{-# LINE 64 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (Remove ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> remove' browserPtr line
add' :: (Ptr ()) -> (String) -> IO ()
add' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  add''_ a1' a2' >>
  return ()

{-# LINE 67 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (String ->  IO ())) => Op (Add ()) Browser orig impl where
  runOp _ _ browser newtext = withRef browser $ \browserPtr -> add' browserPtr newtext
insert' :: (Ptr ()) -> (Int) -> (String) -> IO ()
insert' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = unsafeToCString a3} in 
  insert''_ a1' a2' a3' >>
  return ()

{-# LINE 70 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int -> String ->  IO ())) => Op (Insert ()) Browser orig impl where
  runOp _ _ browser line newtext = withRef browser $ \browserPtr -> insert' browserPtr line newtext
move' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
move' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  move''_ a1' a2' a3' >>
  return ()

{-# LINE 73 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int -> Int ->  IO ())) => Op (Move ()) Browser orig impl where
  runOp _ _ browser to from = withRef browser $ \browserPtr -> move' browserPtr to from
load' :: (Ptr ()) -> (String) -> IO ((Int))
load' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  load''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 76 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (String ->  IO (Int))) => Op (Load ()) Browser orig impl where
  runOp _ _ browser filename = withRef browser $ \browserPtr -> load' browserPtr filename
swap' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
swap' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  swap''_ a1' a2' a3' >>
  return ()

{-# LINE 79 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int -> Int ->  IO ())) => Op (Swap ()) Browser orig impl where
  runOp _ _ browser a b = withRef browser $ \browserPtr -> swap' browserPtr a b
clear' :: (Ptr ()) -> IO ()
clear' a1 =
  let {a1' = id a1} in 
  clear''_ a1' >>
  return ()

{-# LINE 82 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO ())) => Op (Clear ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> clear' browserPtr
size' :: (Ptr ()) -> IO ((Int))
size' a1 =
  let {a1' = id a1} in 
  size''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 85 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Int))) => Op (GetSize ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> size' browserPtr
setSize' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
setSize' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  setSize''_ a1' a2' a3' >>
  return ()

{-# LINE 88 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int -> Int ->  IO ())) => Op (SetSize ()) Browser orig impl where
  runOp _ _ browser w h = withRef browser $ \browserPtr -> setSize' browserPtr w h
topline' :: (Ptr ()) -> IO ((Int))
topline' a1 =
  let {a1' = id a1} in 
  topline''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 91 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Int))) => Op (GetTopline ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> topline' browserPtr
lineposition' :: (Ptr ()) -> (Int) -> (LinePosition) -> IO ()
lineposition' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = cFromEnum a3} in 
  lineposition''_ a1' a2' a3' >>
  return ()

{-# LINE 94 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int -> LinePosition ->  IO ())) => Op (Lineposition ()) Browser orig impl where
  runOp _ _ browser line pos = withRef browser $ \browserPtr -> lineposition' browserPtr line pos
setTopline' :: (Ptr ()) -> (Int) -> IO ()
setTopline' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setTopline''_ a1' a2' >>
  return ()

{-# LINE 97 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (SetTopline ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> setTopline' browserPtr line
bottomline' :: (Ptr ()) -> (Int) -> IO ()
bottomline' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  bottomline''_ a1' a2' >>
  return ()

{-# LINE 100 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (SetBottomline ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> bottomline' browserPtr line
middleline' :: (Ptr ()) -> (Int) -> IO ()
middleline' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  middleline''_ a1' a2' >>
  return ()

{-# LINE 103 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (SetMiddleline ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> middleline' browserPtr line
select' :: (Ptr ()) -> (Int) -> (Bool) -> IO ((Int))
select' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = cFromBool a3} in 
  select''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 106 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int -> Bool -> IO (Int))) => Op (Select ()) Browser orig impl where
  runOp _ _ browser selectType line = withRef browser $ \browserPtr -> select' browserPtr selectType line
selected' :: (Ptr ()) -> (Int) -> IO ((Bool))
selected' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  selected''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 109 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO (Bool))) => Op (Selected ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> selected' browserPtr line
showWithLine' :: (Ptr ()) -> (Int) -> IO ()
showWithLine' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  showWithLine''_ a1' a2' >>
  return ()

{-# LINE 112 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (ShowWidgetLine ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> showWithLine' browserPtr line
show' :: (Ptr ()) -> IO ()
show' a1 =
  let {a1' = id a1} in 
  show''_ a1' >>
  return ()

{-# LINE 115 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO ())) => Op (ShowWidget ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> show' browserPtr
hideWithLine' :: (Ptr ()) -> (Int) -> IO ()
hideWithLine' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  hideWithLine''_ a1' a2' >>
  return ()

{-# LINE 118 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (HideLine ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> hideWithLine' browserPtr line
hide' :: (Ptr ()) -> IO ()
hide' a1 =
  let {a1' = id a1} in 
  hide''_ a1' >>
  return ()

{-# LINE 121 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO ())) => Op (Hide ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> hide' browserPtr
visible' :: (Ptr ()) -> (Int) -> IO ((Int))
visible' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  visible''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 124 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO (Int))) => Op (Visible ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> visible' browserPtr line
value' :: (Ptr ()) -> IO ((Int))
value' a1 =
  let {a1' = id a1} in 
  value''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 127 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Int))) => Op (GetValue ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> value' browserPtr
setValue' :: (Ptr ()) -> (Int) -> IO ()
setValue' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setValue''_ a1' a2' >>
  return ()

{-# LINE 130 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (SetValue ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> setValue' browserPtr line
text' :: (Ptr ()) -> (Int) -> IO ((String))
text' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  text''_ a1' a2' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 133 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO (String))) => Op (GetText ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> text' browserPtr line
setText' :: (Ptr ()) -> (Int) -> (String) -> IO ()
setText' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = unsafeToCString a3} in 
  setText''_ a1' a2' a3' >>
  return ()

{-# LINE 136 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int -> String ->  IO ())) => Op (SetText ()) Browser orig impl where
  runOp _ _ browser line newtext = withRef browser $ \browserPtr -> setText' browserPtr line newtext
formatChar' :: (Ptr ()) -> IO ((CChar))
formatChar' a1 =
  let {a1' = id a1} in 
  formatChar''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 139 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Char))) => Op (GetFormatChar ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> formatChar' browserPtr >>= return . castCCharToChar
setFormatChar' :: (Ptr ()) -> (CChar) -> IO ()
setFormatChar' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  setFormatChar''_ a1' a2' >>
  return ()

{-# LINE 142 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Char ->  IO ())) => Op (SetFormatChar ()) Browser orig impl where
  runOp _ _ browser c = withRef browser $ \browserPtr -> setFormatChar' browserPtr (castCharToCChar c)
columnChar' :: (Ptr ()) -> IO ((CChar))
columnChar' a1 =
  let {a1' = id a1} in 
  columnChar''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 145 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Char))) => Op (GetColumnChar ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> columnChar' browserPtr >>= return . castCCharToChar
setColumnChar' :: (Ptr ()) -> (CChar) -> IO ()
setColumnChar' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  setColumnChar''_ a1' a2' >>
  return ()

{-# LINE 148 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Char ->  IO ())) => Op (SetColumnChar ()) Browser orig impl where
  runOp _ _ browser c = withRef browser $ \browserPtr -> setColumnChar' browserPtr (castCharToCChar c)
columnWidths' :: (Ptr ()) -> IO ((Ptr CInt))
columnWidths' a1 =
  let {a1' = id a1} in 
  columnWidths''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 151 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO [Int])) => Op (GetColumnWidths ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> do
    ptr <- columnWidths' browserPtr
    if (ptr == nullPtr)
      then return []
      else go ptr []
    where
      go ptr accum = do
        curr <- peek ptr
        if (curr == 0)
          then return accum
          else go (ptr `plusPtr` (sizeOf (undefined :: CInt))) (accum ++ [fromIntegral curr])

setColumnWidths' :: (Ptr ()) -> (Ptr CInt) -> IO ()
setColumnWidths' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  setColumnWidths''_ a1' a2' >>
  return ()

{-# LINE 165 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ([Int] ->  IO ())) => Op (SetColumnWidths ()) Browser orig impl where
  runOp _ _ browser arr =
    withRef browser $ \browserPtr -> do
      ptr <- newArray ((map fromIntegral arr) :: [CInt])
      setColumnWidths' browserPtr (castPtr ptr)
displayed' :: (Ptr ()) -> (Int) -> IO ((Bool))
displayed' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  displayed''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 171 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO (Bool))) => Op (Displayed ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> displayed' browserPtr line
makeVisible' :: (Ptr ()) -> (Int) -> IO ()
makeVisible' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  makeVisible''_ a1' a2' >>
  return ()

{-# LINE 174 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (MakeVisible ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> makeVisible' browserPtr line
setIcon' :: (Ptr ()) -> (Int) -> (Ptr ()) -> IO ()
setIcon' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = id a3} in 
  setIcon''_ a1' a2' a3' >>
  return ()

{-# LINE 177 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int -> Ref Image ->  IO ())) => Op (SetIcon ()) Browser orig impl where
  runOp _ _ browser line icon = withRef browser $ \browserPtr -> withRef icon $ \iconPtr -> setIcon' browserPtr line iconPtr
icon' :: (Ptr ()) -> (Int) -> IO ((Ptr ()))
icon' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  icon''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 180 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO (Maybe (Ref Image)))) => Op (GetIcon ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> icon' browserPtr line >>= toMaybeRef
removeIcon' :: (Ptr ()) -> (Int) -> IO ()
removeIcon' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  removeIcon''_ a1' a2' >>
  return ()

{-# LINE 183 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (RemoveIcon ()) Browser orig impl where
  runOp _ _ browser line = withRef browser $ \browserPtr -> removeIcon' browserPtr line
deselect' :: (Ptr ()) -> IO ((Int))
deselect' a1 =
  let {a1' = id a1} in 
  deselect''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 186 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Int))) => Op (Deselect ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> deselect' browserPtr
deselectWithDocallbacks' :: (Ptr ()) -> (Int) -> IO ((Int))
deselectWithDocallbacks' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  deselectWithDocallbacks''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 189 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO (Int))) => Op (DeselectAndCallback ()) Browser orig impl where
  runOp _ _ browser docallbacks = withRef browser $ \browserPtr -> deselectWithDocallbacks' browserPtr docallbacks
position' :: (Ptr ()) -> IO ((Int))
position' a1 =
  let {a1' = id a1} in 
  position''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 192 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Int))) => Op (GetPosition ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> position' browserPtr
setPosition' :: (Ptr ()) -> (Int) -> IO ()
setPosition' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setPosition''_ a1' a2' >>
  return ()

{-# LINE 195 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (SetPosition ()) Browser orig impl where
  runOp _ _ browser pos = withRef browser $ \browserPtr -> setPosition' browserPtr pos
hposition' :: (Ptr ()) -> IO ((Int))
hposition' a1 =
  let {a1' = id a1} in 
  hposition''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 198 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Int))) => Op (GetHposition ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> hposition' browserPtr
setHposition' :: (Ptr ()) -> (Int) -> IO ()
setHposition' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setHposition''_ a1' a2' >>
  return ()

{-# LINE 201 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (SetHposition ()) Browser orig impl where
  runOp _ _ browser int = withRef browser $ \browserPtr -> setHposition' browserPtr int
hasScrollbar' :: (Ptr ()) -> IO ((ScrollbarMode))
hasScrollbar' a1 =
  let {a1' = id a1} in 
  hasScrollbar''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 204 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (ScrollbarMode))) => Op (GetHasScrollbar ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> hasScrollbar' browserPtr
setHasScrollbar' :: (Ptr ()) -> (ScrollbarMode) -> IO ()
setHasScrollbar' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = cFromEnum a2} in 
  setHasScrollbar''_ a1' a2' >>
  return ()

{-# LINE 207 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (ScrollbarMode ->  IO ())) => Op (SetHasScrollbar ()) Browser orig impl where
  runOp _ _ browser mode = withRef browser $ \browserPtr -> setHasScrollbar' browserPtr mode
textfont' :: (Ptr ()) -> IO ((Font))
textfont' a1 =
  let {a1' = id a1} in 
  textfont''_ a1' >>= \res ->
  let {res' = cToFont res} in
  return (res')

{-# LINE 210 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Font))) => Op (GetTextfont ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> textfont' browserPtr
setTextfont' :: (Ptr ()) -> (Font) -> IO ()
setTextfont' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = cFromFont a2} in 
  setTextfont''_ a1' a2' >>
  return ()

{-# LINE 213 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Font ->  IO ())) => Op (SetTextfont ()) Browser orig impl where
  runOp _ _ browser font = withRef browser $ \browserPtr -> setTextfont' browserPtr font
textsize' :: (Ptr ()) -> IO ((CInt))
textsize' a1 =
  let {a1' = id a1} in 
  textsize''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 216 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (FontSize))) => Op (GetTextsize ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> textsize' browserPtr >>= return . FontSize
setTextsize' :: (Ptr ()) -> (CInt) -> IO ()
setTextsize' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  setTextsize''_ a1' a2' >>
  return ()

{-# LINE 219 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (FontSize ->  IO ())) => Op (SetTextsize ()) Browser orig impl where
  runOp _ _ browser (FontSize newsize) = withRef browser $ \browserPtr -> setTextsize' browserPtr newsize
textcolor' :: (Ptr ()) -> IO ((Color))
textcolor' a1 =
  let {a1' = id a1} in 
  textcolor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 222 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Color))) => Op (GetTextcolor ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> textcolor' browserPtr
setTextcolor' :: (Ptr ()) -> (Color) -> IO ()
setTextcolor' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = cFromColor a2} in 
  setTextcolor''_ a1' a2' >>
  return ()

{-# LINE 225 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Color ->  IO ())) => Op (SetTextcolor ()) Browser orig impl where
  runOp _ _ browser col = withRef browser $ \browserPtr -> setTextcolor' browserPtr col
scrollbarSize' :: (Ptr ()) -> IO ((Int))
scrollbarSize' a1 =
  let {a1' = id a1} in 
  scrollbarSize''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 228 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Int))) => Op (GetScrollbarSize ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> scrollbarSize' browserPtr
setScrollbarSize' :: (Ptr ()) -> (Int) -> IO ()
setScrollbarSize' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setScrollbarSize''_ a1' a2' >>
  return ()

{-# LINE 231 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (SetScrollbarSize ()) Browser orig impl where
  runOp _ _ browser newsize = withRef browser $ \browserPtr -> setScrollbarSize' browserPtr newsize
scrollbarWidth' :: (Ptr ()) -> IO ((Int))
scrollbarWidth' a1 =
  let {a1' = id a1} in 
  scrollbarWidth''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 234 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ ( IO (Int))) => Op (GetScrollbarWidth ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> scrollbarWidth' browserPtr
setScrollbarWidth' :: (Ptr ()) -> (Int) -> IO ()
setScrollbarWidth' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setScrollbarWidth''_ a1' a2' >>
  return ()

{-# LINE 237 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (SetScrollbarWidth ()) Browser orig impl where
  runOp _ _ browser width = withRef browser $ \browserPtr -> setScrollbarWidth' browserPtr width
sortWithFlags' :: (Ptr ()) -> (SortType) -> IO ()
sortWithFlags' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = cFromEnum a2} in 
  sortWithFlags''_ a1' a2' >>
  return ()

{-# LINE 240 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (SortType -> IO ())) => Op (SortWithSortType ()) Browser orig impl where
  runOp _ _ browser sorttype' = withRef browser $ \browserPtr -> sortWithFlags' browserPtr sorttype'
sort' :: (Ptr ()) -> IO ()
sort' a1 =
  let {a1' = id a1} in 
  sort''_ a1' >>
  return ()

{-# LINE 243 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ IO ()) => Op (Sort ()) Browser orig impl where
  runOp _ _ browser = withRef browser $ \browserPtr -> sort' browserPtr
setType' :: (Ptr ()) -> (Word8) -> IO ((()))
setType' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setType''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 246 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ (BrowserType ->  IO ())) => Op (SetType ()) Browser orig impl where
  runOp _ _ widget t = withRef widget $ \widgetPtr -> setType' widgetPtr (fromInteger $ toInteger $ fromEnum t)
type' :: (Ptr ()) -> IO ((Word8))
type' a1 =
  let {a1' = id a1} in 
  type''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 249 "src/Graphics/UI/FLTK/LowLevel/Browser.chs" #-}

instance (impl ~ IO (BrowserType)) => Op (GetType_ ()) Browser orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> type' widgetPtr >>= return . toEnum . fromInteger . toInteger

-- $functions
-- @
-- add :: 'Ref' 'Browser' -> 'String' -> 'IO' ()
--
-- clear :: 'Ref' 'Browser' -> 'IO' ()
--
-- deselect :: 'Ref' 'Browser' -> 'IO' ('Int')
--
-- deselectAndCallback :: 'Ref' 'Browser' -> 'Int' -> 'IO' ('Int')
--
-- destroy :: 'Ref' 'Browser' -> 'IO' ()
--
-- displayed :: 'Ref' 'Browser' -> 'Int' -> 'IO' ('Bool')
--
-- getColumnChar :: 'Ref' 'Browser' -> 'IO' ('Char')
--
-- getColumnWidths :: 'Ref' 'Browser' -> 'IO' ['Int']
--
-- getFormatChar :: 'Ref' 'Browser' -> 'IO' ('Char')
--
-- getHasScrollbar :: 'Ref' 'Browser' -> 'IO' ('ScrollbarMode')
--
-- getHposition :: 'Ref' 'Browser' -> 'IO' ('Int')
--
-- getIcon :: 'Ref' 'Browser' -> 'Int' -> 'IO' ('Maybe' ('Ref' 'Image'))
--
-- getPosition :: 'Ref' 'Browser' -> 'IO' ('Int')
--
-- getScrollbarSize :: 'Ref' 'Browser' -> 'IO' ('Int')
--
-- getScrollbarWidth :: 'Ref' 'Browser' -> 'IO' ('Int')
--
-- getSize :: 'Ref' 'Browser' -> 'IO' ('Int')
--
-- getText :: 'Ref' 'Browser' -> 'Int' -> 'IO' ('String')
--
-- getTextcolor :: 'Ref' 'Browser' -> 'IO' ('Color')
--
-- getTextfont :: 'Ref' 'Browser' -> 'IO' ('Font')
--
-- getTextsize :: 'Ref' 'Browser' -> 'IO' ('FontSize')
--
-- getTopline :: 'Ref' 'Browser' -> 'IO' ('Int')
--
-- getType_ :: 'Ref' 'Browser' -> 'IO' ('BrowserType')
--
-- getValue :: 'Ref' 'Browser' -> 'IO' ('Int')
--
-- handle :: 'Ref' 'Browser' -> 'Event' -> 'IO' 'Int'
--
-- hide :: 'Ref' 'Browser' -> 'IO' ()
--
-- hideLine :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- insert :: 'Ref' 'Browser' -> 'Int' -> 'String' -> 'IO' ()
--
-- lineposition :: 'Ref' 'Browser' -> 'Int' -> 'LinePosition' -> 'IO' ()
--
-- load :: 'Ref' 'Browser' -> 'String' -> 'IO' ('Int')
--
-- makeVisible :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- move :: 'Ref' 'Browser' -> 'Int' -> 'Int' -> 'IO' ()
--
-- remove :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- removeIcon :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- select :: 'Ref' 'Browser' -> 'Int' -> 'Bool' -> 'IO' ('Int')
--
-- selected :: 'Ref' 'Browser' -> 'Int' -> 'IO' ('Bool')
--
-- setBottomline :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- setColumnChar :: 'Ref' 'Browser' -> 'Char' -> 'IO' ()
--
-- setColumnWidths :: 'Ref' 'Browser' -> ['Int'] -> 'IO' ()
--
-- setFormatChar :: 'Ref' 'Browser' -> 'Char' -> 'IO' ()
--
-- setHasScrollbar :: 'Ref' 'Browser' -> 'ScrollbarMode'>- 'IO' ()
--
-- setHposition :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- setIcon :: 'Ref' 'Browser' -> 'Int' -> 'Ref' 'Image' -> 'IO' ()
--
-- setMiddleline :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- setPosition :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- setScrollbarSize :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- setScrollbarWidth :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- setSize :: 'Ref' 'Browser' -> 'Int' -> 'Int' -> 'IO' ()
--
-- setText :: 'Ref' 'Browser' -> 'Int' -> 'String' -> 'IO' ()
--
-- setTextcolor :: 'Ref' 'Browser' -> 'Color' -> 'IO' ()
--
-- setTextfont :: 'Ref' 'Browser' -> 'Font' -> 'IO' ()
--
-- setTextsize :: 'Ref' 'Browser' -> 'FontSize' -> 'IO' ()
--
-- setTopline :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- setType :: 'Ref' 'Browser' -> 'BrowserType' -> 'IO' ()
--
-- setValue :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- showWidget :: 'Ref' 'Browser' -> 'IO' ()
--
-- showWidgetLine :: 'Ref' 'Browser' -> 'Int' -> 'IO' ()
--
-- sort :: 'Ref' 'Browser' -> 'IO' ()
--
-- sortWithSortType :: 'Ref' 'Browser' -> 'SortType' -> 'IO' ()
--
-- swap :: 'Ref' 'Browser' -> 'Int' -> 'Int' -> 'IO' ()
--
-- visible :: 'Ref' 'Browser' -> 'Int' -> 'IO' ('Int')
-- @

-- $hierarchy
-- @
-- "Graphics.UI.FLTK.LowLevel.Widget"
--  |
--  v
-- "Graphics.UI.FLTK.LowLevel.Group"
--  |
--  v
-- "Graphics.UI.FLTK.LowLevel.Browser"
-- @
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_New"
  browserNew''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_New_WithLabel"
  browserNewWithLabel''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_OverriddenBrowser_New_WithLabel"
  overriddenBrowserNewWithLabel''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_OverriddenBrowser_New"
  overriddenBrowserNew''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_handle"
  browserHandle''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_Destroy"
  browserDestroy''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_remove"
  remove''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_add"
  add''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_insert"
  insert''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_move"
  move''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_load"
  load''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_swap"
  swap''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_clear"
  clear''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_size"
  size''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_size"
  setSize''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_topline"
  topline''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_lineposition"
  lineposition''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_topline"
  setTopline''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_bottomline"
  bottomline''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_middleline"
  middleline''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_select_with_val"
  select''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_selected"
  selected''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_show_with_line"
  showWithLine''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_show"
  show''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_hide_with_line"
  hideWithLine''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_hide"
  hide''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_visible"
  visible''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_value"
  value''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_value"
  setValue''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_text"
  text''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_text"
  setText''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_format_char"
  formatChar''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_format_char"
  setFormatChar''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CChar -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_column_char"
  columnChar''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_column_char"
  setColumnChar''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CChar -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_column_widths"
  columnWidths''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_column_widths"
  setColumnWidths''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_displayed"
  displayed''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_make_visible"
  makeVisible''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_icon"
  setIcon''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_icon"
  icon''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_remove_icon"
  removeIcon''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_deselect"
  deselect''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_deselect_with_docallbacks"
  deselectWithDocallbacks''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_position"
  position''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_position"
  setPosition''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_hposition"
  hposition''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_hposition"
  setHposition''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_has_scrollbar"
  hasScrollbar''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_has_scrollbar"
  setHasScrollbar''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUChar -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_textfont"
  textfont''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_textfont"
  setTextfont''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_textsize"
  textsize''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_textsize"
  setTextsize''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_textcolor"
  textcolor''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_textcolor"
  setTextcolor''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_scrollbar_size"
  scrollbarSize''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_scrollbar_size"
  setScrollbarSize''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_scrollbar_width"
  scrollbarWidth''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_set_scrollbar_width"
  setScrollbarWidth''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_sort_with_flags"
  sortWithFlags''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Browser_sort"
  sort''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Widget_set_type"
  setType''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUChar -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Browser.chs.h Fl_Widget_type"
  type''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUChar))