-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}
{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.TextBuffer
       (
         textBufferNew
         -- * Hierarchy
         --
         -- $hierarchy

         -- * Functions
         --
         -- $functions
       )
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils 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_Types
import Graphics.UI.FLTK.LowLevel.Utils
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Graphics.UI.FLTK.LowLevel.Dispatch
import qualified Data.Text as T
new' :: IO ((Ptr ()))
new' =
  new''_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 25 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

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

{-# LINE 26 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

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

{-# LINE 27 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

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

{-# LINE 28 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}


textBufferNew :: Maybe Int -> Maybe Int -> IO (Ref TextBuffer)
textBufferNew req' pref' =
  case (req',pref') of
    (Just r', Just p') -> newRequestedSizePreferredGapSize' r' p' >>= toRef
    (Just r', Nothing) -> newRequestedSize' r' >>= toRef
    (Nothing, Just p') -> newPreferredGapSize' p' >>= toRef
    (Nothing, Nothing) -> new' >>= toRef

textbufferDestroy' :: (Ptr ()) -> IO ((()))
textbufferDestroy' a1 =
  let {a1' = id a1} in 
  textbufferDestroy''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 38 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance (impl ~ (IO ())) => Op (Destroy ()) TextBuffer orig impl where
  runOp _ _ textBuffer' = swapRef textBuffer' $ \textBuffer'Ptr -> do
    textbufferDestroy' textBuffer'Ptr
    return nullPtr
inputFileWasTranscoded' :: (Ptr ()) -> IO ((Bool))
inputFileWasTranscoded' a1 =
  let {a1' = id a1} in 
  inputFileWasTranscoded''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 43 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO (Bool))) => Op (InputFileWasTranscoded ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> inputFileWasTranscoded' text_bufferPtr
fileEncodingWarningMessage' :: (Ptr ()) -> IO ((T.Text))
fileEncodingWarningMessage' a1 =
  let {a1' = id a1} in 
  fileEncodingWarningMessage''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 46 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO T.Text)) => Op (FileEncodingWarningMessage ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> fileEncodingWarningMessage' text_bufferPtr
length' :: (Ptr ()) -> IO ((Int))
length' a1 =
  let {a1' = id a1} in 
  length''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 49 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO (Int))) => Op (GetLength ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> length' text_bufferPtr
text' :: (Ptr ()) -> IO ((T.Text))
text' a1 =
  let {a1' = id a1} in 
  text''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 52 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO T.Text)) => Op (GetText ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> text' text_bufferPtr
setText' :: (Ptr ()) -> (T.Text) -> IO ()
setText' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  setText''_ a1' a2' >>
  return ()

{-# LINE 55 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( T.Text ->  IO ())) => Op (SetText ()) TextBuffer orig impl where
   runOp _ _ text_buffer text = withRef text_buffer $ \text_bufferPtr -> setText' text_bufferPtr text
textRange' :: (Ptr ()) -> (Int) -> (Int) -> IO ((T.Text))
textRange' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  textRange''_ a1' a2' a3' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 58 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( BufferRange ->  IO T.Text)) => Op (TextRange ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> textRange' text_bufferPtr start' end'
charAt' :: (Ptr ()) -> (Int) -> IO ((Int))
charAt' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  charAt''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 61 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( BufferOffset ->  IO (Char))) => Op (CharAt ()) TextBuffer orig impl where
  runOp _ _ text_buffer (BufferOffset pos) = withRef text_buffer $ \text_bufferPtr -> charAt' text_bufferPtr pos >>= return . toEnum
byteAt' :: (Ptr ()) -> (Int) -> IO ((Char))
byteAt' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  byteAt''_ a1' a2' >>= \res ->
  let {res' = castCCharToChar res} in
  return (res')

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

instance ( impl ~ ( BufferOffset ->  IO Char)) => Op (ByteAt ()) TextBuffer orig impl where
  runOp _ _ text_buffer (BufferOffset pos) = withRef text_buffer $ \text_bufferPtr -> byteAt' text_bufferPtr pos
insert' :: (Ptr ()) -> (Int) -> (T.Text) -> 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 67 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( BufferOffset -> T.Text ->  IO ())) => Op (Insert ()) TextBuffer orig impl where
  runOp _ _ text_buffer (BufferOffset pos) text = withRef text_buffer $ \text_bufferPtr -> insert' text_bufferPtr pos text
append' :: (Ptr ()) -> (T.Text) -> IO ()
append' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  append''_ a1' a2' >>
  return ()

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

instance ( impl ~ ( T.Text ->  IO ())) => Op (AppendToBuffer ()) TextBuffer orig impl where
   runOp _ _ text_buffer t = withRef text_buffer $ \text_bufferPtr -> append' text_bufferPtr t
remove' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
remove' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  remove''_ a1' a2' a3' >>
  return ()

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

instance ( impl ~ ( BufferRange ->  IO ())) => Op (Remove ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> remove' text_bufferPtr start' end'
replace' :: (Ptr ()) -> (Int) -> (Int) -> (T.Text) -> IO ()
replace' a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = unsafeToCString a4} in 
  replace''_ a1' a2' a3' a4' >>
  return ()

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

instance ( impl ~ ( BufferRange -> T.Text ->  IO ())) => Op (Replace ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) text = withRef text_buffer $ \text_bufferPtr -> replace' text_bufferPtr start' end' text
copy' :: (Ptr ()) -> (Ptr ()) -> (Int) -> (Int) -> (Int) -> IO ()
copy' a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = fromIntegral a5} in 
  copy''_ a1' a2' a3' a4' a5' >>
  return ()

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

instance ( Parent a TextBuffer, impl ~ ( Ref a -> BufferRange -> BufferOffset ->  IO ())) => Op (Copy ()) TextBuffer orig impl where
   runOp _ _ text_buffer frombuf (BufferRange (BufferOffset fromstart) (BufferOffset fromend)) (BufferOffset topos) = withRef text_buffer $ \text_bufferPtr -> withRef frombuf $ \frombufPtr -> copy' text_bufferPtr frombufPtr fromstart fromend topos
undo' :: (Ptr ()) -> (Ptr CInt) -> IO ((Int))
undo' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  undo''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance ( impl ~ (  IO (Either NoChange BufferOffset))) => Op (Undo ()) TextBuffer orig impl where
   runOp _ _ text_buffer =
     withRef text_buffer $ \text_bufferPtr ->
     alloca $ \prevBufferOffsetPtr ->
     undo' text_bufferPtr prevBufferOffsetPtr >>= \status' ->
     if (status' == 0)
      then return (Left NoChange)
      else peekIntConv prevBufferOffsetPtr >>= return . Right . BufferOffset
canUndoWithFlag' :: (Ptr ()) -> (Bool) -> IO ()
canUndoWithFlag' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = cFromBool a2} in 
  canUndoWithFlag''_ a1' a2' >>
  return ()

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

instance ( impl ~ (Bool ->  IO ())) => Op (CanUndo ()) TextBuffer orig impl where
   runOp _ _ text_buffer flag = withRef text_buffer $ \text_bufferPtr -> canUndoWithFlag' text_bufferPtr flag

insertfile' :: (Ptr ()) -> (T.Text) -> (Int) -> IO ((Int))
insertfile' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  let {a3' = fromIntegral a3} in 
  insertfile''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 95 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( T.Text -> BufferOffset -> IO (Either DataProcessingError ()))) => Op (Insertfile ()) TextBuffer orig impl where
   runOp _ _ text_buffer file (BufferOffset pos) =
      withRef text_buffer $ \text_bufferPtr ->
      insertfile' text_bufferPtr file pos >>= return . successOrDataProcessingError

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

{-# LINE 101 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( T.Text -> BufferOffset -> Int -> IO (Either DataProcessingError ()))) => Op (InsertfileWithBuflen ()) TextBuffer orig impl where
   runOp _ _ text_buffer file (BufferOffset pos) buflen =
      withRef text_buffer $ \text_bufferPtr ->
      insertfileWithBuflen' text_bufferPtr file pos buflen >>= return . successOrDataProcessingError
appendfile' :: (Ptr ()) -> (T.Text) -> IO ((Int))
appendfile' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  appendfile''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance ( impl ~ ( T.Text ->  IO (Either DataProcessingError ()))) => Op (Appendfile ()) TextBuffer orig impl where
   runOp _ _ text_buffer file =
     withRef text_buffer $ \text_bufferPtr ->
     appendfile' text_bufferPtr file >>= return . successOrDataProcessingError
appendfileWithBuflen' :: (Ptr ()) -> (T.Text) -> (Int) -> IO ((Int))
appendfileWithBuflen' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  let {a3' = fromIntegral a3} in 
  appendfileWithBuflen''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 111 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( T.Text -> Int ->  IO (Either DataProcessingError ()))) => Op (AppendfileWithBuflen ()) TextBuffer orig impl where
   runOp _ _ text_buffer file buflen =
     withRef text_buffer $ \text_bufferPtr ->
     appendfileWithBuflen' text_bufferPtr file buflen >>= return . successOrDataProcessingError
loadfile' :: (Ptr ()) -> (T.Text) -> IO ((Int))
loadfile' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  loadfile''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 116 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( T.Text ->  IO (Either DataProcessingError ()))) => Op (Loadfile ()) TextBuffer orig impl where
   runOp _ _ text_buffer file =
     withRef text_buffer $ \text_bufferPtr ->
     loadfile' text_bufferPtr file >>= return . successOrDataProcessingError
loadfileWithBuflen' :: (Ptr ()) -> (T.Text) -> (Int) -> IO ((Int))
loadfileWithBuflen' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  let {a3' = fromIntegral a3} in 
  loadfileWithBuflen''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance ( impl ~ ( T.Text -> Int ->  IO (Either DataProcessingError ()))) => Op (LoadfileWithBuflen ()) TextBuffer orig impl where
   runOp _ _ text_buffer file buflen =
     withRef text_buffer $ \text_bufferPtr ->
     loadfileWithBuflen' text_bufferPtr file buflen >>= return . successOrDataProcessingError
outputfile' :: (Ptr ()) -> (T.Text) -> (Int) -> (Int) -> IO ((Int))
outputfile' a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  outputfile''_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 126 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( T.Text -> BufferRange ->  IO (Either DataProcessingError ()))) => Op (Outputfile ()) TextBuffer orig impl where
   runOp _ _ text_buffer file (BufferRange (BufferOffset start') (BufferOffset end')) =
     withRef text_buffer $ \text_bufferPtr ->
     outputfile' text_bufferPtr file start' end' >>= return . successOrDataProcessingError
outputfileWithBuflen' :: (Ptr ()) -> (T.Text) -> (Int) -> (Int) -> (Int) -> IO ((Int))
outputfileWithBuflen' a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = fromIntegral a5} in 
  outputfileWithBuflen''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 131 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( T.Text -> BufferRange -> Int ->  IO (Either DataProcessingError ()))) => Op (OutputfileWithBuflen ()) TextBuffer orig impl where
   runOp _ _ text_buffer file (BufferRange (BufferOffset start') (BufferOffset end')) buflen =
     withRef text_buffer $ \text_bufferPtr ->
     outputfileWithBuflen' text_bufferPtr file start' end' buflen >>= return . successOrDataProcessingError
savefile' :: (Ptr ()) -> (T.Text) -> IO ((Int))
savefile' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  savefile''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance ( impl ~ ( T.Text ->  IO (Either DataProcessingError ()))) => Op (Savefile ()) TextBuffer orig impl where
   runOp _ _ text_buffer file =
     withRef text_buffer $ \text_bufferPtr ->
     savefile' text_bufferPtr file >>= return . successOrDataProcessingError
savefileWithBuflen' :: (Ptr ()) -> (T.Text) -> (Int) -> IO ((Int))
savefileWithBuflen' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  let {a3' = fromIntegral a3} in 
  savefileWithBuflen''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 141 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( T.Text -> Int ->  IO (Either DataProcessingError ()))) => Op (SavefileWithBuflen ()) TextBuffer orig impl where
   runOp _ _ text_buffer file buflen =
     withRef text_buffer $ \text_bufferPtr ->
     savefileWithBuflen' text_bufferPtr file buflen >>= return . successOrDataProcessingError
tabDistance' :: (Ptr ()) -> IO ((Int))
tabDistance' a1 =
  let {a1' = id a1} in 
  tabDistance''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 146 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO (Int))) => Op (GetTabDistance ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> tabDistance' text_bufferPtr
setTabDistance' :: (Ptr ()) -> (Int) -> IO ()
setTabDistance' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setTabDistance''_ a1' a2' >>
  return ()

{-# LINE 149 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( Int ->  IO ())) => Op (SetTabDistance ()) TextBuffer orig impl where
   runOp _ _ text_buffer tabdist = withRef text_buffer $ \text_bufferPtr -> setTabDistance' text_bufferPtr tabdist
select' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
select' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  select''_ a1' a2' a3' >>
  return ()

{-# LINE 152 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( BufferRange ->  IO ())) => Op (Select ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> select' text_bufferPtr start' end'
selected' :: (Ptr ()) -> IO ((Bool))
selected' a1 =
  let {a1' = id a1} in 
  selected''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 155 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO (Bool))) => Op (Selected ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> selected' text_bufferPtr
unselect' :: (Ptr ()) -> IO ()
unselect' a1 =
  let {a1' = id a1} in 
  unselect''_ a1' >>
  return ()

{-# LINE 158 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO ())) => Op (Unselect ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> unselect' text_bufferPtr
selectionPosition' :: (Ptr ()) -> IO ((Int), (Int))
selectionPosition' a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  selectionPosition''_ a1' a2' a3' >>
  peekIntConv  a2'>>= \a2'' -> 
  peekIntConv  a3'>>= \a3'' -> 
  return (a2'', a3'')

{-# LINE 161 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ IO (BufferRange)) => Op (SelectionPosition ()) TextBuffer orig impl where
   runOp _ _ text_buffer =
     withRef text_buffer $ \text_bufferPtr ->
     selectionPosition' text_bufferPtr >>= \(start',end') ->
     return (BufferRange (BufferOffset start') (BufferOffset end'))
selectionText' :: (Ptr ()) -> IO ((T.Text))
selectionText' a1 =
  let {a1' = id a1} in 
  selectionText''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 167 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO T.Text)) => Op (SelectionText ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> selectionText' text_bufferPtr
removeSelection' :: (Ptr ()) -> IO ()
removeSelection' a1 =
  let {a1' = id a1} in 
  removeSelection''_ a1' >>
  return ()

{-# LINE 170 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO ())) => Op (RemoveSelection ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> removeSelection' text_bufferPtr
replaceSelection' :: (Ptr ()) -> (T.Text) -> IO ()
replaceSelection' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  replaceSelection''_ a1' a2' >>
  return ()

{-# LINE 173 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( T.Text ->  IO ())) => Op (ReplaceSelection ()) TextBuffer orig impl where
   runOp _ _ text_buffer text = withRef text_buffer $ \text_bufferPtr -> replaceSelection' text_bufferPtr text
secondarySelect' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
secondarySelect' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  secondarySelect''_ a1' a2' a3' >>
  return ()

{-# LINE 176 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( BufferRange ->  IO ())) => Op (SecondarySelect ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> secondarySelect' text_bufferPtr start' end'
secondarySelected' :: (Ptr ()) -> IO ((Bool))
secondarySelected' a1 =
  let {a1' = id a1} in 
  secondarySelected''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 179 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO (Bool))) => Op (SecondarySelected ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> secondarySelected' text_bufferPtr
setSecondaryUnselect' :: (Ptr ()) -> IO ()
setSecondaryUnselect' a1 =
  let {a1' = id a1} in 
  setSecondaryUnselect''_ a1' >>
  return ()

{-# LINE 182 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO ())) => Op (SecondaryUnselect ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> setSecondaryUnselect' text_bufferPtr
secondarySelectionPosition' :: (Ptr ()) -> IO ((Int), (Int))
secondarySelectionPosition' a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  secondarySelectionPosition''_ a1' a2' a3' >>
  peekIntConv  a2'>>= \a2'' -> 
  peekIntConv  a3'>>= \a3'' -> 
  return (a2'', a3'')

{-# LINE 185 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ IO BufferRange) => Op (SecondarySelectionPosition ()) TextBuffer orig impl where
   runOp _ _ text_buffer =
     withRef text_buffer $ \text_bufferPtr ->
     secondarySelectionPosition' text_bufferPtr >>= \(start',end') ->
     return (BufferRange (BufferOffset start') (BufferOffset end'))
secondarySelectionText' :: (Ptr ()) -> IO ((T.Text))
secondarySelectionText' a1 =
  let {a1' = id a1} in 
  secondarySelectionText''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 191 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO T.Text)) => Op (SecondarySelectionText ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> secondarySelectionText' text_bufferPtr
removeSecondarySelection' :: (Ptr ()) -> IO ()
removeSecondarySelection' a1 =
  let {a1' = id a1} in 
  removeSecondarySelection''_ a1' >>
  return ()

{-# LINE 194 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO ())) => Op (RemoveSecondarySelection ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> removeSecondarySelection' text_bufferPtr
replaceSecondarySelection' :: (Ptr ()) -> (T.Text) -> IO ()
replaceSecondarySelection' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  replaceSecondarySelection''_ a1' a2' >>
  return ()

{-# LINE 197 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( T.Text ->  IO ())) => Op (ReplaceSecondarySelection ()) TextBuffer orig impl where
   runOp _ _ text_buffer text = withRef text_buffer $ \text_bufferPtr -> replaceSecondarySelection' text_bufferPtr text
setHighlight' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
setHighlight' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  setHighlight''_ a1' a2' a3' >>
  return ()

{-# LINE 200 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( BufferRange ->  IO ())) => Op (SetHighlight ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> setHighlight' text_bufferPtr start' end'
highlight' :: (Ptr ()) -> IO ((Bool))
highlight' a1 =
  let {a1' = id a1} in 
  highlight''_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 203 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO (Bool))) => Op (GetHighlight ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> highlight' text_bufferPtr
unhighlight' :: (Ptr ()) -> IO ()
unhighlight' a1 =
  let {a1' = id a1} in 
  unhighlight''_ a1' >>
  return ()

{-# LINE 206 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO ())) => Op (Unhighlight ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> unhighlight' text_bufferPtr
highlightPosition' :: (Ptr ()) -> (Ptr CInt) -> (Ptr CInt) -> IO ((Int))
highlightPosition' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  highlightPosition''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 209 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ IO (Maybe BufferRange)) => Op (HighlightPosition ()) TextBuffer orig impl where
   runOp _ _ text_buffer =
     withRef text_buffer $ \text_bufferPtr ->
     statusToBufferRange (highlightPosition' text_bufferPtr)
highlightText' :: (Ptr ()) -> IO ((T.Text))
highlightText' a1 =
  let {a1' = id a1} in 
  highlightText''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 214 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO T.Text)) => Op (HighlightText ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> highlightText' text_bufferPtr
addModifyCallback' :: (Ptr ()) -> (FunPtr TextModifyCbPrim) -> (Ptr ()) -> IO ()
addModifyCallback' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  addModifyCallback''_ a1' a2' a3' >>
  return ()

{-# LINE 217 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance (impl ~ (TextModifyCb -> IO (FunPtr ()))) => Op (AddModifyCallback ()) TextBuffer orig impl where
   runOp _ _ text_buffer bufmodifiedcb =
     withRef text_buffer $ \text_bufferPtr -> do
       funPtr' <- toTextModifyCbPrim bufmodifiedcb
       addModifyCallback' text_bufferPtr funPtr' nullPtr
       return (castFunPtr funPtr')
removeModifyCallback' :: (Ptr ()) -> (FunPtr TextModifyCbPrim) -> (Ptr ()) -> IO ()
removeModifyCallback' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  removeModifyCallback''_ a1' a2' a3' >>
  return ()

{-# LINE 224 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (FunPtr () ->  IO ())) => Op (RemoveModifyCallback ()) TextBuffer orig impl where
   runOp _ _ text_buffer bufmodifiedcb =
     withRef text_buffer $ \text_bufferPtr ->
     removeModifyCallback' text_bufferPtr (castFunPtr  bufmodifiedcb) nullPtr
callModifyCallbacks' :: (Ptr ()) -> IO ()
callModifyCallbacks' a1 =
  let {a1' = id a1} in 
  callModifyCallbacks''_ a1' >>
  return ()

{-# LINE 229 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO ())) => Op (CallModifyCallbacks ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> callModifyCallbacks' text_bufferPtr
addPredeleteCallback' :: (Ptr ()) -> (FunPtr TextPredeleteCbPrim) -> (Ptr ()) -> IO ()
addPredeleteCallback' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  addPredeleteCallback''_ a1' a2' a3' >>
  return ()

{-# LINE 232 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( TextPredeleteCb ->  IO (FunPtr ()))) => Op (AddPredeleteCallback ()) TextBuffer orig impl where
   runOp _ _ text_buffer bufpredelcb =
     withRef text_buffer $ \text_bufferPtr -> do
       funPtr' <- toTextPredeleteCbPrim bufpredelcb
       addPredeleteCallback' text_bufferPtr funPtr' nullPtr
       return (castFunPtr funPtr')
removePredeleteCallback' :: (Ptr ()) -> (FunPtr TextPredeleteCbPrim) -> (Ptr ()) -> IO ()
removePredeleteCallback' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  removePredeleteCallback''_ a1' a2' a3' >>
  return ()

{-# LINE 239 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (FunPtr () -> IO ())) => Op (RemovePredeleteCallback ()) TextBuffer orig impl where
   runOp _ _ text_buffer predelcb =
     withRef text_buffer $ \text_bufferPtr ->
     removePredeleteCallback' text_bufferPtr (castFunPtr predelcb) nullPtr
callPredeleteCallbacks' :: (Ptr ()) -> IO ()
callPredeleteCallbacks' a1 =
  let {a1' = id a1} in 
  callPredeleteCallbacks''_ a1' >>
  return ()

{-# LINE 244 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO ())) => Op (CallPredeleteCallbacks ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> callPredeleteCallbacks' text_bufferPtr
lineText' :: (Ptr ()) -> (Int) -> IO ((Ptr CChar))
lineText' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  lineText''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 247 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( Int ->  IO (Either OutOfRange String))) => Op (LineText ()) TextBuffer orig impl where
   runOp _ _ text_buffer pos =
     withRef text_buffer $ \text_bufferPtr -> do
     r <- lineText' text_bufferPtr pos
     successOrOutOfRange r (r == nullPtr) peekCString
lineStart' :: (Ptr ()) -> (Int) -> IO ((Int))
lineStart' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  lineStart''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 253 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( Int ->  IO (Either OutOfRange BufferOffset))) => Op (LineStart ()) TextBuffer orig impl where
   runOp _ _ text_buffer pos =
     withRef text_buffer $ \text_bufferPtr -> do
       bp <- lineStart' text_bufferPtr pos
       successOrOutOfRange bp (bp == 0) (return . BufferOffset)
lineEnd' :: (Ptr ()) -> (Int) -> IO ((Int))
lineEnd' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  lineEnd''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 259 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( Int ->  IO (Either OutOfRange BufferOffset))) => Op (LineEnd ()) TextBuffer orig impl where
   runOp _ _ text_buffer pos =
     withRef text_buffer $ \text_bufferPtr -> do
     bp <- lineEnd' text_bufferPtr pos
     successOrOutOfRange bp (bp == 0) (return . BufferOffset)
wordStart' :: (Ptr ()) -> (Int) -> IO ((Int))
wordStart' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  wordStart''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 265 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset ->  IO (Either OutOfRange BufferOffset))) => Op (WordStart ()) TextBuffer orig impl where
  runOp _ _ text_buffer (BufferOffset pos) = withRef text_buffer $ \text_bufferPtr -> do
     bp <- wordStart' text_bufferPtr pos
     successOrOutOfRange bp (bp == 0) (return . BufferOffset)
wordEnd' :: (Ptr ()) -> (Int) -> IO ((Int))
wordEnd' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  wordEnd''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 270 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset ->  IO (Either OutOfRange BufferOffset))) => Op (WordEnd ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferOffset pos) = withRef text_buffer $ \text_bufferPtr -> do
     bp <- wordEnd' text_bufferPtr pos
     successOrOutOfRange bp (bp == 0) (return . BufferOffset)
countDisplayedCharacters' :: (Ptr ()) -> (Int) -> (Int) -> IO ((Int))
countDisplayedCharacters' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  countDisplayedCharacters''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 275 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferRange ->  IO (Int))) => Op (CountDisplayedCharacters ()) TextBuffer orig impl where
  runOp _ _ text_buffer (BufferRange (BufferOffset linestartpos) (BufferOffset targetpos)) = withRef text_buffer $ \text_bufferPtr -> countDisplayedCharacters' text_bufferPtr linestartpos targetpos
skipDisplayedCharacters' :: (Ptr ()) -> (Int) -> (Int) -> IO ((Int))
skipDisplayedCharacters' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  skipDisplayedCharacters''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 278 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset-> Int -> IO (BufferOffset))) => Op (SkipDisplayedCharacters ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferOffset linestartpos) nchars =
     withRef text_buffer $ \text_bufferPtr -> skipDisplayedCharacters' text_bufferPtr linestartpos nchars >>= return . BufferOffset
countLines' :: (Ptr ()) -> (Int) -> (Int) -> IO ((Int))
countLines' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  countLines''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 282 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferRange ->  IO (Int))) => Op (CountLines ()) TextBuffer orig impl where
  runOp _ _ text_buffer (BufferRange (BufferOffset startpos)(BufferOffset endpos)) = withRef text_buffer $ \text_bufferPtr -> countLines' text_bufferPtr startpos endpos
skipLines' :: (Ptr ()) -> (Int) -> (Int) -> IO ((Int))
skipLines' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  skipLines''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 285 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset -> Int ->  IO (BufferOffset))) => Op (SkipLines ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferOffset startpos) nlines = withRef text_buffer $ \text_bufferPtr -> skipLines' text_bufferPtr startpos nlines >>= return . BufferOffset
rewindLines' :: (Ptr ()) -> (Int) -> (Int) -> IO ((Int))
rewindLines' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  rewindLines''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 288 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset -> Int ->  IO (Int))) => Op (RewindLines ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferOffset startpos) nlines = withRef text_buffer $ \text_bufferPtr -> rewindLines' text_bufferPtr startpos nlines
findcharForward' :: (Ptr ()) -> (Int) -> (Int) -> (Ptr CInt) -> IO ((Int))
findcharForward' a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = id a4} in 
  findcharForward''_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 291 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset -> Char ->   IO (Either NotFound BufferOffset))) => Op (FindcharForward ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferOffset startpos) searchchar =
     withRef text_buffer $ \text_bufferPtr ->
     alloca $ \intPtr -> do
     status' <- findcharForward' text_bufferPtr startpos (fromIntegral $ castCharToCChar searchchar) intPtr
     if (status' == 0)
       then return (Left NotFound)
       else peekIntConv intPtr >>= return . Right . BufferOffset
findcharBackward' :: (Ptr ()) -> (Int) -> (Int) -> (Ptr CInt) -> IO ((Int))
findcharBackward' a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = id a4} in 
  findcharBackward''_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 300 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset -> Char -> IO (Either NotFound BufferOffset))) => Op (FindcharBackward ()) TextBuffer orig impl where
  runOp _ _ text_buffer (BufferOffset startpos) searchchar =
     withRef text_buffer $ \text_bufferPtr ->
     alloca $ \intPtr -> do
     status' <- findcharBackward' text_bufferPtr startpos (fromIntegral $ castCharToCChar searchchar) intPtr
     if (status' == 0)
       then return (Left NotFound)
       else peekIntConv intPtr >>= return . Right . BufferOffset
searchForwardWithMatchcase' :: (Ptr ()) -> (Int) -> (T.Text) -> (Ptr CInt) -> (Bool) -> IO ((Int))
searchForwardWithMatchcase' a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = unsafeToCString a3} in 
  let {a4' = id a4} in 
  let {a5' = cFromBool a5} in 
  searchForwardWithMatchcase''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 309 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset -> T.Text -> Bool ->  IO (Either NotFound BufferOffset))) => Op (SearchForwardWithMatchcase ()) TextBuffer orig impl where
  runOp _ _ text_buffer (BufferOffset startpos) searchstring matchcase =
     withRef text_buffer $ \text_bufferPtr ->
     alloca $ \intPtr -> do
     status' <- searchForwardWithMatchcase' text_bufferPtr startpos searchstring intPtr matchcase
     if (status' == 0)
       then return (Left NotFound)
       else peekIntConv intPtr >>= return .  Right . BufferOffset
searchBackwardWithMatchcase' :: (Ptr ()) -> (Int) -> (T.Text) -> (Ptr CInt) -> (Bool) -> IO ((Int))
searchBackwardWithMatchcase' a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = unsafeToCString a3} in 
  let {a4' = id a4} in 
  let {a5' = cFromBool a5} in 
  searchBackwardWithMatchcase''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 318 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset -> T.Text -> Bool ->  IO (Either NotFound BufferOffset))) => Op (SearchBackwardWithMatchcase ()) TextBuffer orig impl where
  runOp _ _ text_buffer (BufferOffset startpos) searchstring matchcase =
     withRef text_buffer $ \text_bufferPtr ->
     alloca $ \intPtr -> do
     status' <- searchBackwardWithMatchcase' text_bufferPtr startpos searchstring intPtr matchcase
     if (status' == 0)
       then return (Left NotFound)
       else peekIntConv intPtr >>= return .  Right . BufferOffset
primarySelection' :: (Ptr ()) -> IO ((Ptr ()))
primarySelection' a1 =
  let {a1' = id a1} in 
  primarySelection''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 327 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO (Maybe (Ref TextSelection)))) => Op (PrimarySelection ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> primarySelection' text_bufferPtr >>= toMaybeRef
secondarySelection' :: (Ptr ()) -> IO ((Ptr ()))
secondarySelection' a1 =
  let {a1' = id a1} in 
  secondarySelection''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 330 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO (Maybe (Ref TextSelection)))) => Op (SecondarySelection ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> secondarySelection' text_bufferPtr >>= toMaybeRef
highlightSelection' :: (Ptr ()) -> IO ((Ptr ()))
highlightSelection' a1 =
  let {a1' = id a1} in 
  highlightSelection''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 333 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (  IO (Maybe (Ref TextSelection)))) => Op (HighlightSelection ()) TextBuffer orig impl where
   runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> highlightSelection' text_bufferPtr >>= toMaybeRef
prevChar' :: (Ptr ()) -> (Int) -> IO ((Int))
prevChar' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  prevChar''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 336 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ ( BufferOffset ->  IO (Either OutOfRange BufferOffset))) => Op (PrevChar ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferOffset ix) =
     withRef text_buffer $ \text_bufferPtr -> do
       p' <- prevChar' text_bufferPtr ix
       successOrOutOfRange p' (p' == 0) (return . BufferOffset)
prevCharClipped' :: (Ptr ()) -> (Int) -> IO ((Int))
prevCharClipped' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  prevCharClipped''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 342 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset ->  IO (Either OutOfRange BufferOffset))) => Op (PrevCharClipped ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferOffset ix) =
     withRef text_buffer $ \text_bufferPtr -> do
     p' <- prevCharClipped' text_bufferPtr ix
     successOrOutOfRange p' (p' == 0) (return . BufferOffset)
nextChar' :: (Ptr ()) -> (Int) -> IO ((Int))
nextChar' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  nextChar''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 348 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset ->  IO BufferOffset)) => Op (NextChar ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferOffset ix) = withRef text_buffer $ \text_bufferPtr -> nextChar' text_bufferPtr ix >>= return . BufferOffset
nextCharClipped' :: (Ptr ()) -> (Int) -> IO ((Int))
nextCharClipped' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  nextCharClipped''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 351 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset ->  IO (BufferOffset))) => Op (NextCharClipped ()) TextBuffer orig impl where
   runOp _ _ text_buffer (BufferOffset ix) = withRef text_buffer $ \text_bufferPtr -> nextCharClipped' text_bufferPtr ix >>= return . BufferOffset
utf8Align' :: (Ptr ()) -> (Int) -> IO ((Int))
utf8Align' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  utf8Align''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 354 "src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs" #-}

instance ( impl ~ (BufferOffset ->  IO (Either OutOfRange BufferOffset))) => Op (Utf8Align ()) TextBuffer orig impl where
  runOp _ _ text_buffer (BufferOffset align) =
     withRef text_buffer $ \text_bufferPtr -> do
     p' <- utf8Align' text_bufferPtr align
     successOrOutOfRange p' (p' == 0) (return . BufferOffset)

-- $hierarchy
-- @
-- "Graphics.UI.FLTK.LowLevel.TextBuffer"
-- @

-- $functions
-- @
-- addModifyCallback :: 'Ref' 'TextBuffer' -> 'TextModifyCb' -> 'IO' ('FunPtr' ())
--
-- addPredeleteCallback :: 'Ref' 'TextBuffer' -> 'TextPredeleteCb' -> 'IO' ('FunPtr' ())
--
-- appendToBuffer :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' ()
--
-- appendfile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' ('Either' 'DataProcessingError' ())
--
-- appendfileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ())
--
-- byteAt :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' 'Char'
--
-- callModifyCallbacks :: 'Ref' 'TextBuffer' -> 'IO' ()
--
-- callPredeleteCallbacks :: 'Ref' 'TextBuffer' -> 'IO' ()
--
-- canUndo :: 'Ref' 'TextBuffer' -> 'Bool' -> 'IO' ()
--
-- charAt :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Char')
--
-- copy:: ('Parent' a 'TextBuffer') => 'Ref' 'TextBuffer' -> 'Ref' a -> 'BufferRange' -> 'BufferOffset' -> 'IO' ()
--
-- countDisplayedCharacters :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' ('Int')
--
-- countLines :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' ('Int')
--
-- destroy :: 'Ref' 'TextBuffer' -> 'IO' ()
--
-- fileEncodingWarningMessage :: 'Ref' 'TextBuffer' -> 'IO' 'T.Text'
--
-- findcharBackward :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'Char' -> 'IO' ('Either' 'NotFound' 'BufferOffset')
--
-- findcharForward :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'Char' -> 'IO' ('Either' 'NotFound' 'BufferOffset')
--
-- getHighlight :: 'Ref' 'TextBuffer' -> 'IO' ('Bool')
--
-- getLength :: 'Ref' 'TextBuffer' -> 'IO' ('Int')
--
-- getTabDistance :: 'Ref' 'TextBuffer' -> 'IO' ('Int')
--
-- getText :: 'Ref' 'TextBuffer' -> 'IO' 'T.Text'
--
-- highlightPosition :: 'Ref' 'TextBuffer' -> 'IO' ('Maybe' 'BufferRange')
--
-- highlightSelection :: 'Ref' 'TextBuffer' -> 'IO' ('Maybe' ('Ref' 'TextSelection'))
--
-- highlightText :: 'Ref' 'TextBuffer' -> 'IO' 'T.Text'
--
-- inputFileWasTranscoded :: 'Ref' 'TextBuffer' -> 'IO' ('Bool')
--
-- insert :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'T.Text' -> 'IO' ()
--
-- insertfile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'BufferOffset' -> 'IO' ('Either' 'DataProcessingError' ())
--
-- insertfileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'BufferOffset' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ())
--
-- lineEnd :: 'Ref' 'TextBuffer' -> 'Int' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset')
--
-- lineStart :: 'Ref' 'TextBuffer' -> 'Int' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset')
--
-- lineText :: 'Ref' 'TextBuffer' -> 'Int' -> 'IO' ('Either' 'OutOfRange' 'String')
--
-- loadfile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' ('Either' 'DataProcessingError' ())
--
-- loadfileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ())
--
-- nextChar :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' 'BufferOffset'
--
-- nextCharClipped :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('BufferOffset')
--
-- outputfile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'BufferRange' -> 'IO' ('Either' 'DataProcessingError' ())
--
-- outputfileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'BufferRange' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ())
--
-- prevChar :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset')
--
-- prevCharClipped :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset')
--
-- primarySelection :: 'Ref' 'TextBuffer' -> 'IO' ('Maybe' ('Ref' 'TextSelection'))
--
-- remove :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' ()
--
-- removeModifyCallback :: 'Ref' 'TextBuffer' -> 'FunPtr' () -> 'IO' ()
--
-- removePredeleteCallback :: 'Ref' 'TextBuffer' -> 'FunPtr' () -> 'IO' ()
--
-- removeSecondarySelection :: 'Ref' 'TextBuffer' -> 'IO' ()
--
-- removeSelection :: 'Ref' 'TextBuffer' -> 'IO' ()
--
-- replace :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'T.Text' -> 'IO' ()
--
-- replaceSecondarySelection :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' ()
--
-- replaceSelection :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' ()
--
-- rewindLines :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'Int' -> 'IO' ('Int')
--
-- savefile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' ('Either' 'DataProcessingError' ())
--
-- savefileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ())
--
-- searchBackwardWithMatchcase :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'T.Text' -> 'Bool' -> 'IO' ('Either' 'NotFound' 'BufferOffset')
--
-- searchForwardWithMatchcase :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'T.Text' -> 'Bool' -> 'IO' ('Either' 'NotFound' 'BufferOffset')
--
-- secondarySelect :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' ()
--
-- secondarySelected :: 'Ref' 'TextBuffer' -> 'IO' ('Bool')
--
-- secondarySelection :: 'Ref' 'TextBuffer' -> 'IO' ('Maybe' ('Ref' 'TextSelection'))
--
-- secondarySelectionPosition :: 'Ref' 'TextBuffer' -> 'IO' 'BufferRange'
--
-- secondarySelectionText :: 'Ref' 'TextBuffer' -> 'IO' 'T.Text'
--
-- secondaryUnselect :: 'Ref' 'TextBuffer' -> 'IO' ()
--
-- select :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' ()
--
-- selected :: 'Ref' 'TextBuffer' -> 'IO' ('Bool')
--
-- selectionPosition :: 'Ref' 'TextBuffer' -> 'IO' ('BufferRange')
--
-- selectionText :: 'Ref' 'TextBuffer' -> 'IO' 'T.Text'
--
-- setHighlight :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' ()
--
-- setTabDistance :: 'Ref' 'TextBuffer' -> 'Int' -> 'IO' ()
--
-- setText :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' ()
--
-- skipDisplayedCharacters :: 'Ref' 'TextBuffer' -> 'BufferOffset'>- 'Int' -> 'IO' ('BufferOffset')
--
-- skipLines :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'Int' -> 'IO' ('BufferOffset')
--
-- textRange :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' 'T.Text'
--
-- undo :: 'Ref' 'TextBuffer' -> 'IO' ('Either' 'NoChange' 'BufferOffset')
--
-- unhighlight :: 'Ref' 'TextBuffer' -> 'IO' ()
--
-- unselect :: 'Ref' 'TextBuffer' -> 'IO' ()
--
-- utf8Align :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset')
--
-- wordEnd :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset')
--
-- wordStart :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset')
-- @

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_New"
  new''_ :: (IO (C2HSImp.Ptr ()))

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_Destroy"
  textbufferDestroy''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

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

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_char_at"
  charAt''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CUInt)))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_unselect"
  unselect''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_remove_selection"
  removeSelection''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_set_secondary_unselect"
  setSecondaryUnselect''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_remove_secondary_selection"
  removeSecondarySelection''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_unhighlight"
  unhighlight''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_add_modify_callback"
  addModifyCallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO ())))))))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_remove_modify_callback"
  removeModifyCallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO ())))))))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_call_modify_callbacks"
  callModifyCallbacks''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_add_predelete_callback"
  addPredeleteCallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO ()))))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_remove_predelete_callback"
  removePredeleteCallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO ()))))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_call_predelete_callbacks"
  callPredeleteCallbacks''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

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

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

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

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

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

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_findchar_forward"
  findcharForward''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_findchar_backward"
  findcharBackward''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_primary_selection"
  primarySelection''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_secondary_selection"
  secondarySelection''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextBuffer.chs.h Fl_Text_Buffer_highlight_selection"
  highlightSelection''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

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

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

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

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

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