{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Auto-indentation interface.
-- 
-- By default, [class/@view@/] can auto-indent as you type when
-- [property/@view@/:auto-indent] is enabled. The indentation simply copies the
-- previous lines indentation.
-- 
-- This can be changed by implementing @GtkSourceIndenter@ and setting the
-- [property/@view@/:indenter] property.
-- 
-- Implementors of this interface should implement both
-- [vfunc/@indenter@/.is_trigger] and [vfunc/@indenter@/.indent].
-- 
-- [vfunc/@indenter@/.is_trigger] is called upon key-press to
-- determine of the key press should trigger an indentation.  The default
-- implementation of the interface checks to see if the key was
-- [const/@gdk@/.KEY_Return] or [const/@gdk@/.KEY_KP_Enter] without 'GI.Gdk.Flags.ModifierTypeShiftMask' set.
-- 
-- [vfunc/@indenter@/.indent] is called after text has been
-- inserted into [class/@buffer@/] when
-- [vfunc/@indenter@/.is_trigger] returned 'P.True'. The [struct/@gtk@/.TextIter]
-- is placed directly after the inserted character or characters.
-- 
-- It may be beneficial to move the insertion mark using
-- 'GI.Gtk.Objects.TextBuffer.textBufferSelectRange' depending on how the indenter changes
-- the indentation.
-- 
-- All changes are encapsulated within a single user action so that the
-- user may undo them using standard undo\/redo accelerators.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.GtkSource.Interfaces.Indenter
    ( 

-- * Exported types
    Indenter(..)                            ,
    IsIndenter                              ,
    toIndenter                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [indent]("GI.GtkSource.Interfaces.Indenter#g:method:indent"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isTrigger]("GI.GtkSource.Interfaces.Indenter#g:method:isTrigger"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveIndenterMethod                   ,
#endif

-- ** indent #method:indent#

#if defined(ENABLE_OVERLOADING)
    IndenterIndentMethodInfo                ,
#endif
    indenterIndent                          ,


-- ** isTrigger #method:isTrigger#

#if defined(ENABLE_OVERLOADING)
    IndenterIsTriggerMethodInfo             ,
#endif
    indenterIsTrigger                       ,




    ) 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gtk.Structs.TextIter as Gtk.TextIter
import {-# SOURCE #-} qualified GI.GtkSource.Objects.View as GtkSource.View

-- interface Indenter 
-- | Memory-managed wrapper type.
newtype Indenter = Indenter (SP.ManagedPtr Indenter)
    deriving (Indenter -> Indenter -> Bool
(Indenter -> Indenter -> Bool)
-> (Indenter -> Indenter -> Bool) -> Eq Indenter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Indenter -> Indenter -> Bool
== :: Indenter -> Indenter -> Bool
$c/= :: Indenter -> Indenter -> Bool
/= :: Indenter -> Indenter -> Bool
Eq)

instance SP.ManagedPtrNewtype Indenter where
    toManagedPtr :: Indenter -> ManagedPtr Indenter
toManagedPtr (Indenter ManagedPtr Indenter
p) = ManagedPtr Indenter
p

foreign import ccall "gtk_source_indenter_get_type"
    c_gtk_source_indenter_get_type :: IO B.Types.GType

instance B.Types.TypedObject Indenter where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_indenter_get_type

instance B.Types.GObject Indenter

-- | Type class for types which can be safely cast to `Indenter`, for instance with `toIndenter`.
class (SP.GObject o, O.IsDescendantOf Indenter o) => IsIndenter o
instance (SP.GObject o, O.IsDescendantOf Indenter o) => IsIndenter o

instance O.HasParentTypes Indenter
type instance O.ParentTypes Indenter = '[GObject.Object.Object]

-- | Cast to `Indenter`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toIndenter :: (MIO.MonadIO m, IsIndenter o) => o -> m Indenter
toIndenter :: forall (m :: * -> *) o.
(MonadIO m, IsIndenter o) =>
o -> m Indenter
toIndenter = IO Indenter -> m Indenter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Indenter -> m Indenter)
-> (o -> IO Indenter) -> o -> m Indenter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Indenter -> Indenter) -> o -> IO Indenter
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Indenter -> Indenter
Indenter

-- | Convert 'Indenter' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Indenter) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_source_indenter_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Indenter -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Indenter
P.Nothing = Ptr GValue -> Ptr Indenter -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Indenter
forall a. Ptr a
FP.nullPtr :: FP.Ptr Indenter)
    gvalueSet_ Ptr GValue
gv (P.Just Indenter
obj) = Indenter -> (Ptr Indenter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Indenter
obj (Ptr GValue -> Ptr Indenter -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Indenter)
gvalueGet_ Ptr GValue
gv = do
        Ptr Indenter
ptr <- Ptr GValue -> IO (Ptr Indenter)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Indenter)
        if Ptr Indenter
ptr Ptr Indenter -> Ptr Indenter -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Indenter
forall a. Ptr a
FP.nullPtr
        then Indenter -> Maybe Indenter
forall a. a -> Maybe a
P.Just (Indenter -> Maybe Indenter) -> IO Indenter -> IO (Maybe Indenter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Indenter -> Indenter) -> Ptr Indenter -> IO Indenter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Indenter -> Indenter
Indenter Ptr Indenter
ptr
        else Maybe Indenter -> IO (Maybe Indenter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Indenter
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Indenter
type instance O.AttributeList Indenter = IndenterAttributeList
type IndenterAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveIndenterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveIndenterMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveIndenterMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveIndenterMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveIndenterMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveIndenterMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveIndenterMethod "indent" o = IndenterIndentMethodInfo
    ResolveIndenterMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveIndenterMethod "isTrigger" o = IndenterIsTriggerMethodInfo
    ResolveIndenterMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveIndenterMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveIndenterMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveIndenterMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveIndenterMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveIndenterMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveIndenterMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveIndenterMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveIndenterMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveIndenterMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveIndenterMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveIndenterMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveIndenterMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveIndenterMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveIndenterMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveIndenterMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveIndenterMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveIndenterMethod t Indenter, O.OverloadedMethod info Indenter p) => OL.IsLabel t (Indenter -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveIndenterMethod t Indenter, O.OverloadedMethod info Indenter p, R.HasField t Indenter p) => R.HasField t Indenter p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveIndenterMethod t Indenter, O.OverloadedMethodInfo info Indenter) => OL.IsLabel t (O.MethodProxy info Indenter) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- method Indenter::indent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Indenter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceIndenter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "view"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "View" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceView" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the location of the indentation request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_indenter_indent" gtk_source_indenter_indent :: 
    Ptr Indenter ->                         -- self : TInterface (Name {namespace = "GtkSource", name = "Indenter"})
    Ptr GtkSource.View.View ->              -- view : TInterface (Name {namespace = "GtkSource", name = "View"})
    Ptr Gtk.TextIter.TextIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO ()

-- | This function should be implemented to alter the indentation of text
-- within the view.
-- 
-- /@view@/ is provided so that the indenter may retrieve settings such as indentation and tab widths.
-- 
-- /@iter@/ is the location where the indentation was requested. This typically
-- is after having just inserted a newline (\\n) character but can be other
-- situations such as a manually requested indentation or reformatting.
-- 
-- See @/Indenter.is_trigger/@ for how to trigger indentation on
-- various characters inserted into the buffer.
-- 
-- The implementor of this function is expected to keep /@iter@/ valid across
-- calls to the function and should contain the location of the insert mark
-- after calling this function.
-- 
-- The default implementation for this virtual function will copy the
-- indentation of the previous line.
indenterIndent ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndenter a, GtkSource.View.IsView b) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.Indenter.Indenter'
    -> b
    -- ^ /@view@/: a t'GI.GtkSource.Objects.View.View'
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: the location of the indentation request
    -> m (Gtk.TextIter.TextIter)
indenterIndent :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsIndenter a, IsView b) =>
a -> b -> TextIter -> m TextIter
indenterIndent a
self b
view TextIter
iter = IO TextIter -> m TextIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextIter -> m TextIter) -> IO TextIter -> m TextIter
forall a b. (a -> b) -> a -> b
$ do
    Ptr Indenter
self' <- a -> IO (Ptr Indenter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr View
view' <- b -> IO (Ptr View)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
view
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    Ptr TextIter
iter'' <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter -> Ptr TextIter -> Int -> IO ()
forall a b. Ptr a -> Ptr b -> Int -> IO ()
memcpy Ptr TextIter
iter'' Ptr TextIter
iter' Int
80
    Ptr Indenter -> Ptr View -> Ptr TextIter -> IO ()
gtk_source_indenter_indent Ptr Indenter
self' Ptr View
view' Ptr TextIter
iter''
    TextIter
iter''' <- ((ManagedPtr TextIter -> TextIter) -> Ptr TextIter -> IO TextIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter) Ptr TextIter
iter''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
view
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
    TextIter -> IO TextIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextIter
iter'''

#if defined(ENABLE_OVERLOADING)
data IndenterIndentMethodInfo
instance (signature ~ (b -> Gtk.TextIter.TextIter -> m (Gtk.TextIter.TextIter)), MonadIO m, IsIndenter a, GtkSource.View.IsView b) => O.OverloadedMethod IndenterIndentMethodInfo a signature where
    overloadedMethod = indenterIndent

instance O.OverloadedMethodInfo IndenterIndentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Interfaces.Indenter.indenterIndent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.0/docs/GI-GtkSource-Interfaces-Indenter.html#v:indenterIndent"
        })


#endif

-- method Indenter::is_trigger
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Indenter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceIndenter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "view"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "View" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceView" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "location"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the location where @ch is to be inserted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "modifier state for the insertion"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the keyval pressed such as [const@Gdk.KEY_Return]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_indenter_is_trigger" gtk_source_indenter_is_trigger :: 
    Ptr Indenter ->                         -- self : TInterface (Name {namespace = "GtkSource", name = "Indenter"})
    Ptr GtkSource.View.View ->              -- view : TInterface (Name {namespace = "GtkSource", name = "View"})
    Ptr Gtk.TextIter.TextIter ->            -- location : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    CUInt ->                                -- state : TInterface (Name {namespace = "Gdk", name = "ModifierType"})
    Word32 ->                               -- keyval : TBasicType TUInt
    IO CInt

-- | This function is used to determine if a key pressed should cause the
-- indenter to automatically indent.
-- 
-- The default implementation of this virtual method will check to see
-- if /@keyval@/ is [const/@gdk@/.KEY_Return] or [const/@gdk@/.KEY_KP_Enter] and /@state@/ does
-- not have 'GI.Gdk.Flags.ModifierTypeShiftMask' set. This is to allow the user to avoid
-- indentation when Shift+Return is pressed. Other indenters may want
-- to copy this behavior to provide a consistent experience to users.
indenterIsTrigger ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndenter a, GtkSource.View.IsView b) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.Indenter.Indenter'
    -> b
    -- ^ /@view@/: a t'GI.GtkSource.Objects.View.View'
    -> Gtk.TextIter.TextIter
    -- ^ /@location@/: the location where /@ch@/ is to be inserted
    -> [Gdk.Flags.ModifierType]
    -- ^ /@state@/: modifier state for the insertion
    -> Word32
    -- ^ /@keyval@/: the keyval pressed such as [const/@gdk@/.KEY_Return]
    -> m Bool
    -- ^ __Returns:__ 'P.True' if indentation should be automatically triggered;
    --   otherwise 'P.False' and no indentation will be performed.
indenterIsTrigger :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsIndenter a, IsView b) =>
a -> b -> TextIter -> [ModifierType] -> Word32 -> m Bool
indenterIsTrigger a
self b
view TextIter
location [ModifierType]
state Word32
keyval = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Indenter
self' <- a -> IO (Ptr Indenter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr View
view' <- b -> IO (Ptr View)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
view
    Ptr TextIter
location' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
location
    let state' :: CUInt
state' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
state
    CInt
result <- Ptr Indenter
-> Ptr View -> Ptr TextIter -> CUInt -> Word32 -> IO CInt
gtk_source_indenter_is_trigger Ptr Indenter
self' Ptr View
view' Ptr TextIter
location' CUInt
state' Word32
keyval
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
view
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
location
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IndenterIsTriggerMethodInfo
instance (signature ~ (b -> Gtk.TextIter.TextIter -> [Gdk.Flags.ModifierType] -> Word32 -> m Bool), MonadIO m, IsIndenter a, GtkSource.View.IsView b) => O.OverloadedMethod IndenterIsTriggerMethodInfo a signature where
    overloadedMethod = indenterIsTrigger

instance O.OverloadedMethodInfo IndenterIsTriggerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Interfaces.Indenter.indenterIsTrigger",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.0/docs/GI-GtkSource-Interfaces-Indenter.html#v:indenterIsTrigger"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Indenter = IndenterSignalList
type IndenterSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif