{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Vte.Callbacks
    ( 

 -- * Signals
-- ** SelectionFunc #signal:SelectionFunc#
    C_SelectionFunc                         ,
    SelectionFunc                           ,
    SelectionFunc_WithClosures              ,
    drop_closures_SelectionFunc             ,
    dynamic_SelectionFunc                   ,
    genClosure_SelectionFunc                ,
    mk_SelectionFunc                        ,
    noSelectionFunc                         ,
    noSelectionFunc_WithClosures            ,
    wrap_SelectionFunc                      ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP

import {-# SOURCE #-} qualified GI.Vte.Objects.Terminal as Vte.Terminal

-- callback SelectionFunc
--          -> Callable {returnType = Just (TBasicType TBoolean), returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Just "%TRUE if cell has to be selected; %FALSE if otherwise.", sinceVersion = Nothing}, args = [Arg {argCName = "terminal", argType = TInterface (Name {namespace = "Vte", name = "Terminal"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "terminal in which the cell is.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "column", argType = TBasicType TLong, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "column in which the cell is.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "row", argType = TBasicType TLong, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "row in which the cell is.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "user data.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = 3, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Just "Specifies the type of a selection function used to check whether\na cell has to be selected or not.", sinceVersion = Nothing}}
type C_SelectionFunc =
    Ptr Vte.Terminal.Terminal ->
    CLong ->
    CLong ->
    Ptr () ->
    IO CInt

-- Args : [Arg {argCName = "terminal", argType = TInterface (Name {namespace = "Vte", name = "Terminal"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "terminal in which the cell is.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "column", argType = TBasicType TLong, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "column in which the cell is.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "row", argType = TBasicType TLong, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "row in which the cell is.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "user data.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = 3, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_SelectionFunc :: FunPtr C_SelectionFunc -> C_SelectionFunc

dynamic_SelectionFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Vte.Terminal.IsTerminal a) =>
    FunPtr C_SelectionFunc
    -> a
    {- ^ /@terminal@/: terminal in which the cell is. -}
    -> CLong
    {- ^ /@column@/: column in which the cell is. -}
    -> CLong
    {- ^ /@row@/: row in which the cell is. -}
    -> Ptr ()
    {- ^ /@data@/: user data. -}
    -> m Bool
    {- ^ __Returns:__ 'True' if cell has to be selected; 'False' if otherwise. -}
dynamic_SelectionFunc __funPtr terminal column row data_ = liftIO $ do
    terminal' <- unsafeManagedPtrCastPtr terminal
    result <- (__dynamic_C_SelectionFunc __funPtr) terminal' column row data_
    let result' = (/= 0) result
    touchManagedPtr terminal
    return result'

foreign import ccall "wrapper"
    mk_SelectionFunc :: C_SelectionFunc -> IO (FunPtr C_SelectionFunc)

type SelectionFunc =
    Vte.Terminal.Terminal ->
    CLong ->
    CLong ->
    IO Bool

noSelectionFunc :: Maybe SelectionFunc
noSelectionFunc = Nothing

type SelectionFunc_WithClosures =
    Vte.Terminal.Terminal ->
    CLong ->
    CLong ->
    Ptr () ->
    IO Bool

noSelectionFunc_WithClosures :: Maybe SelectionFunc_WithClosures
noSelectionFunc_WithClosures = Nothing

drop_closures_SelectionFunc :: SelectionFunc -> SelectionFunc_WithClosures
drop_closures_SelectionFunc _f terminal column row _ = _f terminal column row

genClosure_SelectionFunc :: SelectionFunc -> IO Closure
genClosure_SelectionFunc cb = do
    let cb' = drop_closures_SelectionFunc cb
    let cb'' = wrap_SelectionFunc Nothing cb'
    mk_SelectionFunc cb'' >>= newCClosure


wrap_SelectionFunc ::
    Maybe (Ptr (FunPtr C_SelectionFunc)) ->
    SelectionFunc_WithClosures ->
    Ptr Vte.Terminal.Terminal ->
    CLong ->
    CLong ->
    Ptr () ->
    IO CInt
wrap_SelectionFunc funptrptr _cb terminal column row data_ = do
    terminal' <- (newObject Vte.Terminal.Terminal) terminal
    result <- _cb  terminal' column row data_
    maybeReleaseFunPtr funptrptr
    let result' = (fromIntegral . fromEnum) result
    return result'