{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Context for expanding [class/@snippetChunk@/].
-- 
-- This class is currently used primary as a hashtable. However, the longer
-- term goal is to have it hold onto a @GjsContext@ as well as other languages
-- so that [class/@snippetChunk@/] can expand themselves by executing
-- script within the context.
-- 
-- The [class/@snippet@/] will build the context and then expand each of the
-- chunks during the insertion\/edit phase.

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

module GI.GtkSource.Objects.SnippetContext
    ( 

-- * Exported types
    SnippetContext(..)                      ,
    IsSnippetContext                        ,
    toSnippetContext                        ,


 -- * 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"), [clearVariables]("GI.GtkSource.Objects.SnippetContext#g:method:clearVariables"), [expand]("GI.GtkSource.Objects.SnippetContext#g:method:expand"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [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"), [getVariable]("GI.GtkSource.Objects.SnippetContext#g:method:getVariable").
-- 
-- ==== Setters
-- [setConstant]("GI.GtkSource.Objects.SnippetContext#g:method:setConstant"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setLinePrefix]("GI.GtkSource.Objects.SnippetContext#g:method:setLinePrefix"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTabWidth]("GI.GtkSource.Objects.SnippetContext#g:method:setTabWidth"), [setUseSpaces]("GI.GtkSource.Objects.SnippetContext#g:method:setUseSpaces"), [setVariable]("GI.GtkSource.Objects.SnippetContext#g:method:setVariable").

#if defined(ENABLE_OVERLOADING)
    ResolveSnippetContextMethod             ,
#endif

-- ** clearVariables #method:clearVariables#

#if defined(ENABLE_OVERLOADING)
    SnippetContextClearVariablesMethodInfo  ,
#endif
    snippetContextClearVariables            ,


-- ** expand #method:expand#

#if defined(ENABLE_OVERLOADING)
    SnippetContextExpandMethodInfo          ,
#endif
    snippetContextExpand                    ,


-- ** getVariable #method:getVariable#

#if defined(ENABLE_OVERLOADING)
    SnippetContextGetVariableMethodInfo     ,
#endif
    snippetContextGetVariable               ,


-- ** new #method:new#

    snippetContextNew                       ,


-- ** setConstant #method:setConstant#

#if defined(ENABLE_OVERLOADING)
    SnippetContextSetConstantMethodInfo     ,
#endif
    snippetContextSetConstant               ,


-- ** setLinePrefix #method:setLinePrefix#

#if defined(ENABLE_OVERLOADING)
    SnippetContextSetLinePrefixMethodInfo   ,
#endif
    snippetContextSetLinePrefix             ,


-- ** setTabWidth #method:setTabWidth#

#if defined(ENABLE_OVERLOADING)
    SnippetContextSetTabWidthMethodInfo     ,
#endif
    snippetContextSetTabWidth               ,


-- ** setUseSpaces #method:setUseSpaces#

#if defined(ENABLE_OVERLOADING)
    SnippetContextSetUseSpacesMethodInfo    ,
#endif
    snippetContextSetUseSpaces              ,


-- ** setVariable #method:setVariable#

#if defined(ENABLE_OVERLOADING)
    SnippetContextSetVariableMethodInfo     ,
#endif
    snippetContextSetVariable               ,




 -- * Signals


-- ** changed #signal:changed#

    SnippetContextChangedCallback           ,
#if defined(ENABLE_OVERLOADING)
    SnippetContextChangedSignalInfo         ,
#endif
    afterSnippetContextChanged              ,
    onSnippetContextChanged                 ,




    ) 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

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

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

foreign import ccall "gtk_source_snippet_context_get_type"
    c_gtk_source_snippet_context_get_type :: IO B.Types.GType

instance B.Types.TypedObject SnippetContext where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_snippet_context_get_type

instance B.Types.GObject SnippetContext

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

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

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

-- | Convert 'SnippetContext' 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 SnippetContext) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_source_snippet_context_get_type
    gvalueSet_ :: Ptr GValue -> Maybe SnippetContext -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SnippetContext
P.Nothing = Ptr GValue -> Ptr SnippetContext -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SnippetContext
forall a. Ptr a
FP.nullPtr :: FP.Ptr SnippetContext)
    gvalueSet_ Ptr GValue
gv (P.Just SnippetContext
obj) = SnippetContext -> (Ptr SnippetContext -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SnippetContext
obj (Ptr GValue -> Ptr SnippetContext -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe SnippetContext)
gvalueGet_ Ptr GValue
gv = do
        Ptr SnippetContext
ptr <- Ptr GValue -> IO (Ptr SnippetContext)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SnippetContext)
        if Ptr SnippetContext
ptr Ptr SnippetContext -> Ptr SnippetContext -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SnippetContext
forall a. Ptr a
FP.nullPtr
        then SnippetContext -> Maybe SnippetContext
forall a. a -> Maybe a
P.Just (SnippetContext -> Maybe SnippetContext)
-> IO SnippetContext -> IO (Maybe SnippetContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SnippetContext -> SnippetContext)
-> Ptr SnippetContext -> IO SnippetContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SnippetContext -> SnippetContext
SnippetContext Ptr SnippetContext
ptr
        else Maybe SnippetContext -> IO (Maybe SnippetContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SnippetContext
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveSnippetContextMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSnippetContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSnippetContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSnippetContextMethod "clearVariables" o = SnippetContextClearVariablesMethodInfo
    ResolveSnippetContextMethod "expand" o = SnippetContextExpandMethodInfo
    ResolveSnippetContextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSnippetContextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSnippetContextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSnippetContextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSnippetContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSnippetContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSnippetContextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSnippetContextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSnippetContextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSnippetContextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSnippetContextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSnippetContextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSnippetContextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSnippetContextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSnippetContextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSnippetContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSnippetContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSnippetContextMethod "getVariable" o = SnippetContextGetVariableMethodInfo
    ResolveSnippetContextMethod "setConstant" o = SnippetContextSetConstantMethodInfo
    ResolveSnippetContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSnippetContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSnippetContextMethod "setLinePrefix" o = SnippetContextSetLinePrefixMethodInfo
    ResolveSnippetContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSnippetContextMethod "setTabWidth" o = SnippetContextSetTabWidthMethodInfo
    ResolveSnippetContextMethod "setUseSpaces" o = SnippetContextSetUseSpacesMethodInfo
    ResolveSnippetContextMethod "setVariable" o = SnippetContextSetVariableMethodInfo
    ResolveSnippetContextMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveSnippetContextMethod t SnippetContext, O.OverloadedMethod info SnippetContext p) => OL.IsLabel t (SnippetContext -> 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 ~ ResolveSnippetContextMethod t SnippetContext, O.OverloadedMethod info SnippetContext p, R.HasField t SnippetContext p) => R.HasField t SnippetContext p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- signal SnippetContext::changed
-- | The signal is emitted when a change has been
-- discovered in one of the chunks of the snippet which has
-- caused a variable or other dynamic data within the context
-- to have changed.
type SnippetContextChangedCallback =
    IO ()

type C_SnippetContextChangedCallback =
    Ptr SnippetContext ->                   -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_SnippetContextChangedCallback`.
foreign import ccall "wrapper"
    mk_SnippetContextChangedCallback :: C_SnippetContextChangedCallback -> IO (FunPtr C_SnippetContextChangedCallback)

wrap_SnippetContextChangedCallback :: 
    GObject a => (a -> SnippetContextChangedCallback) ->
    C_SnippetContextChangedCallback
wrap_SnippetContextChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_SnippetContextChangedCallback
wrap_SnippetContextChangedCallback a -> IO ()
gi'cb Ptr SnippetContext
gi'selfPtr Ptr ()
_ = do
    Ptr SnippetContext -> (SnippetContext -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr SnippetContext
gi'selfPtr ((SnippetContext -> IO ()) -> IO ())
-> (SnippetContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SnippetContext
gi'self -> a -> IO ()
gi'cb (SnippetContext -> a
forall a b. Coercible a b => a -> b
Coerce.coerce SnippetContext
gi'self) 


-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' snippetContext #changed callback
-- @
-- 
-- 
onSnippetContextChanged :: (IsSnippetContext a, MonadIO m) => a -> ((?self :: a) => SnippetContextChangedCallback) -> m SignalHandlerId
onSnippetContextChanged :: forall a (m :: * -> *).
(IsSnippetContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onSnippetContextChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_SnippetContextChangedCallback
wrapped' = (a -> IO ()) -> C_SnippetContextChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_SnippetContextChangedCallback
wrap_SnippetContextChangedCallback a -> IO ()
wrapped
    FunPtr C_SnippetContextChangedCallback
wrapped'' <- C_SnippetContextChangedCallback
-> IO (FunPtr C_SnippetContextChangedCallback)
mk_SnippetContextChangedCallback C_SnippetContextChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_SnippetContextChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_SnippetContextChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' snippetContext #changed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterSnippetContextChanged :: (IsSnippetContext a, MonadIO m) => a -> ((?self :: a) => SnippetContextChangedCallback) -> m SignalHandlerId
afterSnippetContextChanged :: forall a (m :: * -> *).
(IsSnippetContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterSnippetContextChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_SnippetContextChangedCallback
wrapped' = (a -> IO ()) -> C_SnippetContextChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_SnippetContextChangedCallback
wrap_SnippetContextChangedCallback a -> IO ()
wrapped
    FunPtr C_SnippetContextChangedCallback
wrapped'' <- C_SnippetContextChangedCallback
-> IO (FunPtr C_SnippetContextChangedCallback)
mk_SnippetContextChangedCallback C_SnippetContextChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_SnippetContextChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_SnippetContextChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data SnippetContextChangedSignalInfo
instance SignalInfo SnippetContextChangedSignalInfo where
    type HaskellCallbackType SnippetContextChangedSignalInfo = SnippetContextChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SnippetContextChangedCallback cb
        cb'' <- mk_SnippetContextChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetContext::changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.0/docs/GI-GtkSource-Objects-SnippetContext.html#g:signal:changed"})

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method SnippetContext::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkSource" , name = "SnippetContext" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_context_new" gtk_source_snippet_context_new :: 
    IO (Ptr SnippetContext)

-- | Creates a new t'GI.GtkSource.Objects.SnippetContext.SnippetContext'.
-- 
-- Generally, this isn\'t needed unless you are controlling the
-- expansion of snippets manually.
snippetContextNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m SnippetContext
    -- ^ __Returns:__ a t'GI.GtkSource.Objects.SnippetContext.SnippetContext'
snippetContextNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m SnippetContext
snippetContextNew  = IO SnippetContext -> m SnippetContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SnippetContext -> m SnippetContext)
-> IO SnippetContext -> m SnippetContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetContext
result <- IO (Ptr SnippetContext)
gtk_source_snippet_context_new
    Text -> Ptr SnippetContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetContextNew" Ptr SnippetContext
result
    SnippetContext
result' <- ((ManagedPtr SnippetContext -> SnippetContext)
-> Ptr SnippetContext -> IO SnippetContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SnippetContext -> SnippetContext
SnippetContext) Ptr SnippetContext
result
    SnippetContext -> IO SnippetContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SnippetContext
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SnippetContext::clear_variables
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_context_clear_variables" gtk_source_snippet_context_clear_variables :: 
    Ptr SnippetContext ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetContext"})
    IO ()

-- | Removes all variables from the context.
snippetContextClearVariables ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.SnippetContext.SnippetContext'
    -> m ()
snippetContextClearVariables :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetContext a) =>
a -> m ()
snippetContextClearVariables a
self = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetContext
self' <- a -> IO (Ptr SnippetContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SnippetContext -> IO ()
gtk_source_snippet_context_clear_variables Ptr SnippetContext
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetContextClearVariablesMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSnippetContext a) => O.OverloadedMethod SnippetContextClearVariablesMethodInfo a signature where
    overloadedMethod = snippetContextClearVariables

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


#endif

-- method SnippetContext::expand
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "input"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_context_expand" gtk_source_snippet_context_expand :: 
    Ptr SnippetContext ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetContext"})
    CString ->                              -- input : TBasicType TUTF8
    IO CString

-- | /No description available in the introspection data./
snippetContextExpand ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetContext a) =>
    a
    -> T.Text
    -> m T.Text
snippetContextExpand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetContext a) =>
a -> Text -> m Text
snippetContextExpand a
self Text
input = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetContext
self' <- a -> IO (Ptr SnippetContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
input' <- Text -> IO CString
textToCString Text
input
    CString
result <- Ptr SnippetContext -> CString -> IO CString
gtk_source_snippet_context_expand Ptr SnippetContext
self' CString
input'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetContextExpand" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
input'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SnippetContextExpandMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsSnippetContext a) => O.OverloadedMethod SnippetContextExpandMethodInfo a signature where
    overloadedMethod = snippetContextExpand

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


#endif

-- method SnippetContext::get_variable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the variable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_context_get_variable" gtk_source_snippet_context_get_variable :: 
    Ptr SnippetContext ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetContext"})
    CString ->                              -- key : TBasicType TUTF8
    IO CString

-- | Gets the current value for a variable named /@key@/.
snippetContextGetVariable ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.SnippetContext.SnippetContext'
    -> T.Text
    -- ^ /@key@/: the name of the variable
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the value for the variable, or 'P.Nothing'
snippetContextGetVariable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetContext a) =>
a -> Text -> m (Maybe Text)
snippetContextGetVariable a
self Text
key = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetContext
self' <- a -> IO (Ptr SnippetContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
result <- Ptr SnippetContext -> CString -> IO CString
gtk_source_snippet_context_get_variable Ptr SnippetContext
self' CString
key'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SnippetContextGetVariableMethodInfo
instance (signature ~ (T.Text -> m (Maybe T.Text)), MonadIO m, IsSnippetContext a) => O.OverloadedMethod SnippetContextGetVariableMethodInfo a signature where
    overloadedMethod = snippetContextGetVariable

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


#endif

-- method SnippetContext::set_constant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the constant name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the constant"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_context_set_constant" gtk_source_snippet_context_set_constant :: 
    Ptr SnippetContext ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetContext"})
    CString ->                              -- key : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO ()

-- | Sets a constatnt within the context.
-- 
-- This is similar to a variable set with [method/@snippetContext@/.set_variable]
-- but is expected to not change during use of the snippet.
-- 
-- Examples would be the date or users name.
snippetContextSetConstant ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.SnippetContext.SnippetContext'
    -> T.Text
    -- ^ /@key@/: the constant name
    -> T.Text
    -- ^ /@value@/: the value of the constant
    -> m ()
snippetContextSetConstant :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetContext a) =>
a -> Text -> Text -> m ()
snippetContextSetConstant a
self Text
key Text
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetContext
self' <- a -> IO (Ptr SnippetContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
value' <- Text -> IO CString
textToCString Text
value
    Ptr SnippetContext -> CString -> CString -> IO ()
gtk_source_snippet_context_set_constant Ptr SnippetContext
self' CString
key' CString
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetContextSetConstantMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsSnippetContext a) => O.OverloadedMethod SnippetContextSetConstantMethodInfo a signature where
    overloadedMethod = snippetContextSetConstant

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


#endif

-- method SnippetContext::set_line_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_prefix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_context_set_line_prefix" gtk_source_snippet_context_set_line_prefix :: 
    Ptr SnippetContext ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetContext"})
    CString ->                              -- line_prefix : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
snippetContextSetLinePrefix ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetContext a) =>
    a
    -> T.Text
    -> m ()
snippetContextSetLinePrefix :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetContext a) =>
a -> Text -> m ()
snippetContextSetLinePrefix a
self Text
linePrefix = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetContext
self' <- a -> IO (Ptr SnippetContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
linePrefix' <- Text -> IO CString
textToCString Text
linePrefix
    Ptr SnippetContext -> CString -> IO ()
gtk_source_snippet_context_set_line_prefix Ptr SnippetContext
self' CString
linePrefix'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
linePrefix'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetContextSetLinePrefixMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsSnippetContext a) => O.OverloadedMethod SnippetContextSetLinePrefixMethodInfo a signature where
    overloadedMethod = snippetContextSetLinePrefix

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


#endif

-- method SnippetContext::set_tab_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tab_width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_context_set_tab_width" gtk_source_snippet_context_set_tab_width :: 
    Ptr SnippetContext ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetContext"})
    Int32 ->                                -- tab_width : TBasicType TInt
    IO ()

-- | /No description available in the introspection data./
snippetContextSetTabWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetContext a) =>
    a
    -> Int32
    -> m ()
snippetContextSetTabWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetContext a) =>
a -> Int32 -> m ()
snippetContextSetTabWidth a
self Int32
tabWidth = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetContext
self' <- a -> IO (Ptr SnippetContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SnippetContext -> Int32 -> IO ()
gtk_source_snippet_context_set_tab_width Ptr SnippetContext
self' Int32
tabWidth
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetContextSetTabWidthMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsSnippetContext a) => O.OverloadedMethod SnippetContextSetTabWidthMethodInfo a signature where
    overloadedMethod = snippetContextSetTabWidth

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


#endif

-- method SnippetContext::set_use_spaces
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "use_spaces"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_context_set_use_spaces" gtk_source_snippet_context_set_use_spaces :: 
    Ptr SnippetContext ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetContext"})
    CInt ->                                 -- use_spaces : TBasicType TBoolean
    IO ()

-- | /No description available in the introspection data./
snippetContextSetUseSpaces ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetContext a) =>
    a
    -> Bool
    -> m ()
snippetContextSetUseSpaces :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetContext a) =>
a -> Bool -> m ()
snippetContextSetUseSpaces a
self Bool
useSpaces = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetContext
self' <- a -> IO (Ptr SnippetContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let useSpaces' :: CInt
useSpaces' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
useSpaces
    Ptr SnippetContext -> CInt -> IO ()
gtk_source_snippet_context_set_use_spaces Ptr SnippetContext
self' CInt
useSpaces'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetContextSetUseSpacesMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSnippetContext a) => O.OverloadedMethod SnippetContextSetUseSpacesMethodInfo a signature where
    overloadedMethod = snippetContextSetUseSpaces

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


#endif

-- method SnippetContext::set_variable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the variable name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value for the variable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_context_set_variable" gtk_source_snippet_context_set_variable :: 
    Ptr SnippetContext ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetContext"})
    CString ->                              -- key : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO ()

-- | Sets a variable within the context.
-- 
-- This variable may be overridden by future updates to the
-- context.
snippetContextSetVariable ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.SnippetContext.SnippetContext'
    -> T.Text
    -- ^ /@key@/: the variable name
    -> T.Text
    -- ^ /@value@/: the value for the variable
    -> m ()
snippetContextSetVariable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetContext a) =>
a -> Text -> Text -> m ()
snippetContextSetVariable a
self Text
key Text
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetContext
self' <- a -> IO (Ptr SnippetContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
value' <- Text -> IO CString
textToCString Text
value
    Ptr SnippetContext -> CString -> CString -> IO ()
gtk_source_snippet_context_set_variable Ptr SnippetContext
self' CString
key' CString
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetContextSetVariableMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsSnippetContext a) => O.OverloadedMethod SnippetContextSetVariableMethodInfo a signature where
    overloadedMethod = snippetContextSetVariable

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


#endif