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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The context of a completion.
-- 
-- @GtkSourceCompletionContext@ contains information about an attept to display
-- completion proposals to the user based on typed text in the [class/@view@/].
-- 
-- When typing, [class/@completion@/] may use registered
-- [iface/@completionProvider@/] to determine if there may be results which
-- could be displayed. If so, a @GtkSourceCompletionContext@ is created with
-- information that is provided to the [iface/@completionProvider@/] to populate
-- results which might be useful to the user.
-- 
-- [iface/@completionProvider@/] are expected to provide t'GI.Gio.Interfaces.ListModel.ListModel' with
-- [iface/@completionProposal@/] which may be joined together in a list of
-- results for the user. They are also responsible for how the contents are
-- displayed using [class/@completionCell@/] which allows for some level of
-- customization.

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

module GI.GtkSource.Objects.CompletionContext
    ( 

-- * Exported types
    CompletionContext(..)                   ,
    IsCompletionContext                     ,
    toCompletionContext                     ,


 -- * 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"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [itemsChanged]("GI.Gio.Interfaces.ListModel#g:method:itemsChanged"), [listProviders]("GI.GtkSource.Objects.CompletionContext#g:method:listProviders"), [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
-- [getActivation]("GI.GtkSource.Objects.CompletionContext#g:method:getActivation"), [getBounds]("GI.GtkSource.Objects.CompletionContext#g:method:getBounds"), [getBuffer]("GI.GtkSource.Objects.CompletionContext#g:method:getBuffer"), [getBusy]("GI.GtkSource.Objects.CompletionContext#g:method:getBusy"), [getCompletion]("GI.GtkSource.Objects.CompletionContext#g:method:getCompletion"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getEmpty]("GI.GtkSource.Objects.CompletionContext#g:method:getEmpty"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getLanguage]("GI.GtkSource.Objects.CompletionContext#g:method:getLanguage"), [getNItems]("GI.Gio.Interfaces.ListModel#g:method:getNItems"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getProposalsForProvider]("GI.GtkSource.Objects.CompletionContext#g:method:getProposalsForProvider"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getView]("GI.GtkSource.Objects.CompletionContext#g:method:getView"), [getWord]("GI.GtkSource.Objects.CompletionContext#g:method:getWord").
-- 
-- ==== 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"), [setProposalsForProvider]("GI.GtkSource.Objects.CompletionContext#g:method:setProposalsForProvider").

#if defined(ENABLE_OVERLOADING)
    ResolveCompletionContextMethod          ,
#endif

-- ** getActivation #method:getActivation#

#if defined(ENABLE_OVERLOADING)
    CompletionContextGetActivationMethodInfo,
#endif
    completionContextGetActivation          ,


-- ** getBounds #method:getBounds#

#if defined(ENABLE_OVERLOADING)
    CompletionContextGetBoundsMethodInfo    ,
#endif
    completionContextGetBounds              ,


-- ** getBuffer #method:getBuffer#

#if defined(ENABLE_OVERLOADING)
    CompletionContextGetBufferMethodInfo    ,
#endif
    completionContextGetBuffer              ,


-- ** getBusy #method:getBusy#

#if defined(ENABLE_OVERLOADING)
    CompletionContextGetBusyMethodInfo      ,
#endif
    completionContextGetBusy                ,


-- ** getCompletion #method:getCompletion#

#if defined(ENABLE_OVERLOADING)
    CompletionContextGetCompletionMethodInfo,
#endif
    completionContextGetCompletion          ,


-- ** getEmpty #method:getEmpty#

#if defined(ENABLE_OVERLOADING)
    CompletionContextGetEmptyMethodInfo     ,
#endif
    completionContextGetEmpty               ,


-- ** getLanguage #method:getLanguage#

#if defined(ENABLE_OVERLOADING)
    CompletionContextGetLanguageMethodInfo  ,
#endif
    completionContextGetLanguage            ,


-- ** getProposalsForProvider #method:getProposalsForProvider#

#if defined(ENABLE_OVERLOADING)
    CompletionContextGetProposalsForProviderMethodInfo,
#endif
    completionContextGetProposalsForProvider,


-- ** getView #method:getView#

#if defined(ENABLE_OVERLOADING)
    CompletionContextGetViewMethodInfo      ,
#endif
    completionContextGetView                ,


-- ** getWord #method:getWord#

#if defined(ENABLE_OVERLOADING)
    CompletionContextGetWordMethodInfo      ,
#endif
    completionContextGetWord                ,


-- ** listProviders #method:listProviders#

#if defined(ENABLE_OVERLOADING)
    CompletionContextListProvidersMethodInfo,
#endif
    completionContextListProviders          ,


-- ** setProposalsForProvider #method:setProposalsForProvider#

#if defined(ENABLE_OVERLOADING)
    CompletionContextSetProposalsForProviderMethodInfo,
#endif
    completionContextSetProposalsForProvider,




 -- * Properties


-- ** busy #attr:busy#
-- | The \"busy\" property is 'P.True' while the completion context is
-- populating completion proposals.

#if defined(ENABLE_OVERLOADING)
    CompletionContextBusyPropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    completionContextBusy                   ,
#endif
    getCompletionContextBusy                ,


-- ** completion #attr:completion#
-- | The \"completion\" is the t'GI.GtkSource.Objects.Completion.Completion' that was used to create the context.

#if defined(ENABLE_OVERLOADING)
    CompletionContextCompletionPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
    completionContextCompletion             ,
#endif
    constructCompletionContextCompletion    ,
    getCompletionContextCompletion          ,


-- ** empty #attr:empty#
-- | The \"empty\" property is 'P.True' when there are no results.
-- 
-- It will be notified when the first result is added or the last
-- result is removed.

#if defined(ENABLE_OVERLOADING)
    CompletionContextEmptyPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    completionContextEmpty                  ,
#endif
    getCompletionContextEmpty               ,




 -- * Signals


-- ** providerModelChanged #signal:providerModelChanged#

    CompletionContextProviderModelChangedCallback,
#if defined(ENABLE_OVERLOADING)
    CompletionContextProviderModelChangedSignalInfo,
#endif
    afterCompletionContextProviderModelChanged,
    onCompletionContextProviderModelChanged ,




    ) 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.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gtk.Structs.TextIter as Gtk.TextIter
import {-# SOURCE #-} qualified GI.GtkSource.Enums as GtkSource.Enums
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.CompletionProvider as GtkSource.CompletionProvider
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Buffer as GtkSource.Buffer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Completion as GtkSource.Completion
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Language as GtkSource.Language
import {-# SOURCE #-} qualified GI.GtkSource.Objects.View as GtkSource.View

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

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

foreign import ccall "gtk_source_completion_context_get_type"
    c_gtk_source_completion_context_get_type :: IO B.Types.GType

instance B.Types.TypedObject CompletionContext where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_completion_context_get_type

instance B.Types.GObject CompletionContext

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

instance O.HasParentTypes CompletionContext
type instance O.ParentTypes CompletionContext = '[GObject.Object.Object, Gio.ListModel.ListModel]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveCompletionContextMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveCompletionContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCompletionContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCompletionContextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCompletionContextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCompletionContextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCompletionContextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCompletionContextMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
    ResolveCompletionContextMethod "listProviders" o = CompletionContextListProvidersMethodInfo
    ResolveCompletionContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCompletionContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCompletionContextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCompletionContextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCompletionContextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCompletionContextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCompletionContextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCompletionContextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCompletionContextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCompletionContextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCompletionContextMethod "getActivation" o = CompletionContextGetActivationMethodInfo
    ResolveCompletionContextMethod "getBounds" o = CompletionContextGetBoundsMethodInfo
    ResolveCompletionContextMethod "getBuffer" o = CompletionContextGetBufferMethodInfo
    ResolveCompletionContextMethod "getBusy" o = CompletionContextGetBusyMethodInfo
    ResolveCompletionContextMethod "getCompletion" o = CompletionContextGetCompletionMethodInfo
    ResolveCompletionContextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCompletionContextMethod "getEmpty" o = CompletionContextGetEmptyMethodInfo
    ResolveCompletionContextMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveCompletionContextMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveCompletionContextMethod "getLanguage" o = CompletionContextGetLanguageMethodInfo
    ResolveCompletionContextMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveCompletionContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCompletionContextMethod "getProposalsForProvider" o = CompletionContextGetProposalsForProviderMethodInfo
    ResolveCompletionContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCompletionContextMethod "getView" o = CompletionContextGetViewMethodInfo
    ResolveCompletionContextMethod "getWord" o = CompletionContextGetWordMethodInfo
    ResolveCompletionContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCompletionContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCompletionContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCompletionContextMethod "setProposalsForProvider" o = CompletionContextSetProposalsForProviderMethodInfo
    ResolveCompletionContextMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal CompletionContext::provider-model-changed
-- | Emitted when a provider changes a model.
-- 
-- This signal is primarily useful for t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'\'s
-- that want to track other providers in context. For example, it can
-- be used to create a \"top results\" provider.
-- 
-- /Since: 5.6/
type CompletionContextProviderModelChangedCallback =
    GtkSource.CompletionProvider.CompletionProvider
    -- ^ /@provider@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> Maybe Gio.ListModel.ListModel
    -- ^ /@model@/: a t'GI.Gio.Interfaces.ListModel.ListModel'
    -> IO ()

type C_CompletionContextProviderModelChangedCallback =
    Ptr CompletionContext ->                -- object
    Ptr GtkSource.CompletionProvider.CompletionProvider ->
    Ptr Gio.ListModel.ListModel ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_CompletionContextProviderModelChangedCallback :: 
    GObject a => (a -> CompletionContextProviderModelChangedCallback) ->
    C_CompletionContextProviderModelChangedCallback
wrap_CompletionContextProviderModelChangedCallback :: forall a.
GObject a =>
(a -> CompletionContextProviderModelChangedCallback)
-> C_CompletionContextProviderModelChangedCallback
wrap_CompletionContextProviderModelChangedCallback a -> CompletionContextProviderModelChangedCallback
gi'cb Ptr CompletionContext
gi'selfPtr Ptr CompletionProvider
provider Ptr ListModel
model Ptr ()
_ = do
    CompletionProvider
provider' <- ((ManagedPtr CompletionProvider -> CompletionProvider)
-> Ptr CompletionProvider -> IO CompletionProvider
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr CompletionProvider -> CompletionProvider
GtkSource.CompletionProvider.CompletionProvider) Ptr CompletionProvider
provider
    Maybe ListModel
maybeModel <-
        if Ptr ListModel
model Ptr ListModel -> Ptr ListModel -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ListModel
forall a. Ptr a
nullPtr
        then Maybe ListModel -> IO (Maybe ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListModel
forall a. Maybe a
Nothing
        else do
            ListModel
model' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
model
            Maybe ListModel -> IO (Maybe ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ListModel -> IO (Maybe ListModel))
-> Maybe ListModel -> IO (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ ListModel -> Maybe ListModel
forall a. a -> Maybe a
Just ListModel
model'
    Ptr CompletionContext -> (CompletionContext -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr CompletionContext
gi'selfPtr ((CompletionContext -> IO ()) -> IO ())
-> (CompletionContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CompletionContext
gi'self -> a -> CompletionContextProviderModelChangedCallback
gi'cb (CompletionContext -> a
forall a b. Coercible a b => a -> b
Coerce.coerce CompletionContext
gi'self)  CompletionProvider
provider' Maybe ListModel
maybeModel


-- | Connect a signal handler for the [providerModelChanged](#signal:providerModelChanged) 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' completionContext #providerModelChanged callback
-- @
-- 
-- 
onCompletionContextProviderModelChanged :: (IsCompletionContext a, MonadIO m) => a -> ((?self :: a) => CompletionContextProviderModelChangedCallback) -> m SignalHandlerId
onCompletionContextProviderModelChanged :: forall a (m :: * -> *).
(IsCompletionContext a, MonadIO m) =>
a
-> ((?self::a) => CompletionContextProviderModelChangedCallback)
-> m SignalHandlerId
onCompletionContextProviderModelChanged a
obj (?self::a) => CompletionContextProviderModelChangedCallback
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 -> CompletionContextProviderModelChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => CompletionContextProviderModelChangedCallback
CompletionContextProviderModelChangedCallback
cb
    let wrapped' :: C_CompletionContextProviderModelChangedCallback
wrapped' = (a -> CompletionContextProviderModelChangedCallback)
-> C_CompletionContextProviderModelChangedCallback
forall a.
GObject a =>
(a -> CompletionContextProviderModelChangedCallback)
-> C_CompletionContextProviderModelChangedCallback
wrap_CompletionContextProviderModelChangedCallback a -> CompletionContextProviderModelChangedCallback
wrapped
    FunPtr C_CompletionContextProviderModelChangedCallback
wrapped'' <- C_CompletionContextProviderModelChangedCallback
-> IO (FunPtr C_CompletionContextProviderModelChangedCallback)
mk_CompletionContextProviderModelChangedCallback C_CompletionContextProviderModelChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_CompletionContextProviderModelChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"provider-model-changed" FunPtr C_CompletionContextProviderModelChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [providerModelChanged](#signal:providerModelChanged) 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' completionContext #providerModelChanged 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.
-- 
afterCompletionContextProviderModelChanged :: (IsCompletionContext a, MonadIO m) => a -> ((?self :: a) => CompletionContextProviderModelChangedCallback) -> m SignalHandlerId
afterCompletionContextProviderModelChanged :: forall a (m :: * -> *).
(IsCompletionContext a, MonadIO m) =>
a
-> ((?self::a) => CompletionContextProviderModelChangedCallback)
-> m SignalHandlerId
afterCompletionContextProviderModelChanged a
obj (?self::a) => CompletionContextProviderModelChangedCallback
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 -> CompletionContextProviderModelChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => CompletionContextProviderModelChangedCallback
CompletionContextProviderModelChangedCallback
cb
    let wrapped' :: C_CompletionContextProviderModelChangedCallback
wrapped' = (a -> CompletionContextProviderModelChangedCallback)
-> C_CompletionContextProviderModelChangedCallback
forall a.
GObject a =>
(a -> CompletionContextProviderModelChangedCallback)
-> C_CompletionContextProviderModelChangedCallback
wrap_CompletionContextProviderModelChangedCallback a -> CompletionContextProviderModelChangedCallback
wrapped
    FunPtr C_CompletionContextProviderModelChangedCallback
wrapped'' <- C_CompletionContextProviderModelChangedCallback
-> IO (FunPtr C_CompletionContextProviderModelChangedCallback)
mk_CompletionContextProviderModelChangedCallback C_CompletionContextProviderModelChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_CompletionContextProviderModelChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"provider-model-changed" FunPtr C_CompletionContextProviderModelChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


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

#endif

-- VVV Prop "busy"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@busy@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionContext #busy
-- @
getCompletionContextBusy :: (MonadIO m, IsCompletionContext o) => o -> m Bool
getCompletionContextBusy :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionContext o) =>
o -> m Bool
getCompletionContextBusy o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"busy"

#if defined(ENABLE_OVERLOADING)
data CompletionContextBusyPropertyInfo
instance AttrInfo CompletionContextBusyPropertyInfo where
    type AttrAllowedOps CompletionContextBusyPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint CompletionContextBusyPropertyInfo = IsCompletionContext
    type AttrSetTypeConstraint CompletionContextBusyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint CompletionContextBusyPropertyInfo = (~) ()
    type AttrTransferType CompletionContextBusyPropertyInfo = ()
    type AttrGetType CompletionContextBusyPropertyInfo = Bool
    type AttrLabel CompletionContextBusyPropertyInfo = "busy"
    type AttrOrigin CompletionContextBusyPropertyInfo = CompletionContext
    attrGet = getCompletionContextBusy
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.CompletionContext.busy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.0/docs/GI-GtkSource-Objects-CompletionContext.html#g:attr:busy"
        })
#endif

-- VVV Prop "completion"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "Completion"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@completion@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionContext #completion
-- @
getCompletionContextCompletion :: (MonadIO m, IsCompletionContext o) => o -> m (Maybe GtkSource.Completion.Completion)
getCompletionContextCompletion :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionContext o) =>
o -> m (Maybe Completion)
getCompletionContextCompletion o
obj = IO (Maybe Completion) -> m (Maybe Completion)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Completion) -> m (Maybe Completion))
-> IO (Maybe Completion) -> m (Maybe Completion)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr Completion -> Completion)
-> IO (Maybe Completion)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"completion" ManagedPtr Completion -> Completion
GtkSource.Completion.Completion

-- | Construct a `GValueConstruct` with valid value for the “@completion@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionContextCompletion :: (IsCompletionContext o, MIO.MonadIO m, GtkSource.Completion.IsCompletion a) => a -> m (GValueConstruct o)
constructCompletionContextCompletion :: forall o (m :: * -> *) a.
(IsCompletionContext o, MonadIO m, IsCompletion a) =>
a -> m (GValueConstruct o)
constructCompletionContextCompletion a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"completion" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data CompletionContextCompletionPropertyInfo
instance AttrInfo CompletionContextCompletionPropertyInfo where
    type AttrAllowedOps CompletionContextCompletionPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CompletionContextCompletionPropertyInfo = IsCompletionContext
    type AttrSetTypeConstraint CompletionContextCompletionPropertyInfo = GtkSource.Completion.IsCompletion
    type AttrTransferTypeConstraint CompletionContextCompletionPropertyInfo = GtkSource.Completion.IsCompletion
    type AttrTransferType CompletionContextCompletionPropertyInfo = GtkSource.Completion.Completion
    type AttrGetType CompletionContextCompletionPropertyInfo = (Maybe GtkSource.Completion.Completion)
    type AttrLabel CompletionContextCompletionPropertyInfo = "completion"
    type AttrOrigin CompletionContextCompletionPropertyInfo = CompletionContext
    attrGet = getCompletionContextCompletion
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo GtkSource.Completion.Completion v
    attrConstruct = constructCompletionContextCompletion
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.CompletionContext.completion"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.0/docs/GI-GtkSource-Objects-CompletionContext.html#g:attr:completion"
        })
#endif

-- VVV Prop "empty"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@empty@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionContext #empty
-- @
getCompletionContextEmpty :: (MonadIO m, IsCompletionContext o) => o -> m Bool
getCompletionContextEmpty :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionContext o) =>
o -> m Bool
getCompletionContextEmpty o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"empty"

#if defined(ENABLE_OVERLOADING)
data CompletionContextEmptyPropertyInfo
instance AttrInfo CompletionContextEmptyPropertyInfo where
    type AttrAllowedOps CompletionContextEmptyPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint CompletionContextEmptyPropertyInfo = IsCompletionContext
    type AttrSetTypeConstraint CompletionContextEmptyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint CompletionContextEmptyPropertyInfo = (~) ()
    type AttrTransferType CompletionContextEmptyPropertyInfo = ()
    type AttrGetType CompletionContextEmptyPropertyInfo = Bool
    type AttrLabel CompletionContextEmptyPropertyInfo = "empty"
    type AttrOrigin CompletionContextEmptyPropertyInfo = CompletionContext
    attrGet = getCompletionContextEmpty
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.CompletionContext.empty"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.0/docs/GI-GtkSource-Objects-CompletionContext.html#g:attr:empty"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CompletionContext
type instance O.AttributeList CompletionContext = CompletionContextAttributeList
type CompletionContextAttributeList = ('[ '("busy", CompletionContextBusyPropertyInfo), '("completion", CompletionContextCompletionPropertyInfo), '("empty", CompletionContextEmptyPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
completionContextBusy :: AttrLabelProxy "busy"
completionContextBusy = AttrLabelProxy

completionContextCompletion :: AttrLabelProxy "completion"
completionContextCompletion = AttrLabelProxy

completionContextEmpty :: AttrLabelProxy "empty"
completionContextEmpty = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList CompletionContext = CompletionContextSignalList
type CompletionContextSignalList = ('[ '("itemsChanged", Gio.ListModel.ListModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("providerModelChanged", CompletionContextProviderModelChangedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

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

-- | Gets the mode for which the context was activated.
completionContextGetActivation ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m GtkSource.Enums.CompletionActivation
completionContextGetActivation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionContext a) =>
a -> m CompletionActivation
completionContextGetActivation a
self = IO CompletionActivation -> m CompletionActivation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompletionActivation -> m CompletionActivation)
-> IO CompletionActivation -> m CompletionActivation
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr CompletionContext -> IO CUInt
gtk_source_completion_context_get_activation Ptr CompletionContext
self'
    let result' :: CompletionActivation
result' = (Int -> CompletionActivation
forall a. Enum a => Int -> a
toEnum (Int -> CompletionActivation)
-> (CUInt -> Int) -> CUInt -> CompletionActivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CompletionActivation -> IO CompletionActivation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompletionActivation
result'

#if defined(ENABLE_OVERLOADING)
data CompletionContextGetActivationMethodInfo
instance (signature ~ (m GtkSource.Enums.CompletionActivation), MonadIO m, IsCompletionContext a) => O.OverloadedMethod CompletionContextGetActivationMethodInfo a signature where
    overloadedMethod = completionContextGetActivation

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


#endif

-- method CompletionContext::get_bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #GtkSourceCompletionContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "begin"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextIter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextIter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_completion_context_get_bounds" gtk_source_completion_context_get_bounds :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    Ptr Gtk.TextIter.TextIter ->            -- begin : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO CInt

-- | Gets the bounds for the completion, which is the beginning of the
-- current word (taking break characters into account) to the current
-- insertion cursor.
-- 
-- If /@begin@/ is non-'P.Nothing', it will be set to the start position of the
-- current word being completed.
-- 
-- If /@end@/ is non-'P.Nothing', it will be set to the insertion cursor for the
-- current word being completed.
completionContextGetBounds ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a) =>
    a
    -- ^ /@self@/: an t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))
    -- ^ __Returns:__ 'P.True' if the marks are still valid and /@begin@/ or /@end@/ was set.
completionContextGetBounds :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionContext a) =>
a -> m (Bool, TextIter, TextIter)
completionContextGetBounds a
self = IO (Bool, TextIter, TextIter) -> m (Bool, TextIter, TextIter)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, TextIter, TextIter) -> m (Bool, TextIter, TextIter))
-> IO (Bool, TextIter, TextIter) -> m (Bool, TextIter, TextIter)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TextIter
begin <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter
end <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    CInt
result <- Ptr CompletionContext -> Ptr TextIter -> Ptr TextIter -> IO CInt
gtk_source_completion_context_get_bounds Ptr CompletionContext
self' Ptr TextIter
begin Ptr TextIter
end
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TextIter
begin' <- ((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
begin
    TextIter
end' <- ((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
end
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    (Bool, TextIter, TextIter) -> IO (Bool, TextIter, TextIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', TextIter
begin', TextIter
end')

#if defined(ENABLE_OVERLOADING)
data CompletionContextGetBoundsMethodInfo
instance (signature ~ (m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))), MonadIO m, IsCompletionContext a) => O.OverloadedMethod CompletionContextGetBoundsMethodInfo a signature where
    overloadedMethod = completionContextGetBounds

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


#endif

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

foreign import ccall "gtk_source_completion_context_get_buffer" gtk_source_completion_context_get_buffer :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    IO (Ptr GtkSource.Buffer.Buffer)

-- | Gets the underlying buffer used by the context.
-- 
-- This is a convenience function to get the buffer via the t'GI.GtkSource.Objects.Completion.Completion'
-- property.
completionContextGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a) =>
    a
    -- ^ /@self@/: an t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m (Maybe GtkSource.Buffer.Buffer)
    -- ^ __Returns:__ a t'GI.Gtk.Objects.TextBuffer.TextBuffer' or 'P.Nothing'
completionContextGetBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionContext a) =>
a -> m (Maybe Buffer)
completionContextGetBuffer a
self = IO (Maybe Buffer) -> m (Maybe Buffer)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Buffer
result <- Ptr CompletionContext -> IO (Ptr Buffer)
gtk_source_completion_context_get_buffer Ptr CompletionContext
self'
    Maybe Buffer
maybeResult <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Buffer
result ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
result' -> do
        Buffer
result'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Buffer -> Buffer
GtkSource.Buffer.Buffer) Ptr Buffer
result'
        Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Buffer -> IO (Maybe Buffer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data CompletionContextGetBufferMethodInfo
instance (signature ~ (m (Maybe GtkSource.Buffer.Buffer)), MonadIO m, IsCompletionContext a) => O.OverloadedMethod CompletionContextGetBufferMethodInfo a signature where
    overloadedMethod = completionContextGetBuffer

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


#endif

-- method CompletionContext::get_busy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , 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_completion_context_get_busy" gtk_source_completion_context_get_busy :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    IO CInt

-- | Gets the \"busy\" property. This is set to 'P.True' while the completion
-- context is actively fetching proposals from registered
-- t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'\'s.
completionContextGetBusy ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the context is busy
completionContextGetBusy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionContext a) =>
a -> m Bool
completionContextGetBusy a
self = 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 CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr CompletionContext -> IO CInt
gtk_source_completion_context_get_busy Ptr CompletionContext
self'
    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
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CompletionContextGetBusyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsCompletionContext a) => O.OverloadedMethod CompletionContextGetBusyMethodInfo a signature where
    overloadedMethod = completionContextGetBusy

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


#endif

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

foreign import ccall "gtk_source_completion_context_get_completion" gtk_source_completion_context_get_completion :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    IO (Ptr GtkSource.Completion.Completion)

-- | Gets the t'GI.GtkSource.Objects.Completion.Completion' that created the context.
completionContextGetCompletion ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a) =>
    a
    -- ^ /@self@/: an t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m (Maybe GtkSource.Completion.Completion)
    -- ^ __Returns:__ an t'GI.GtkSource.Objects.Completion.Completion' or 'P.Nothing'
completionContextGetCompletion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionContext a) =>
a -> m (Maybe Completion)
completionContextGetCompletion a
self = IO (Maybe Completion) -> m (Maybe Completion)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Completion) -> m (Maybe Completion))
-> IO (Maybe Completion) -> m (Maybe Completion)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Completion
result <- Ptr CompletionContext -> IO (Ptr Completion)
gtk_source_completion_context_get_completion Ptr CompletionContext
self'
    Maybe Completion
maybeResult <- Ptr Completion
-> (Ptr Completion -> IO Completion) -> IO (Maybe Completion)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Completion
result ((Ptr Completion -> IO Completion) -> IO (Maybe Completion))
-> (Ptr Completion -> IO Completion) -> IO (Maybe Completion)
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
result' -> do
        Completion
result'' <- ((ManagedPtr Completion -> Completion)
-> Ptr Completion -> IO Completion
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Completion -> Completion
GtkSource.Completion.Completion) Ptr Completion
result'
        Completion -> IO Completion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Completion
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Completion -> IO (Maybe Completion)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Completion
maybeResult

#if defined(ENABLE_OVERLOADING)
data CompletionContextGetCompletionMethodInfo
instance (signature ~ (m (Maybe GtkSource.Completion.Completion)), MonadIO m, IsCompletionContext a) => O.OverloadedMethod CompletionContextGetCompletionMethodInfo a signature where
    overloadedMethod = completionContextGetCompletion

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


#endif

-- method CompletionContext::get_empty
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , 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_completion_context_get_empty" gtk_source_completion_context_get_empty :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    IO CInt

-- | Checks if any proposals have been provided to the context.
-- 
-- Out of convenience, this function will return 'P.True' if /@self@/ is 'P.Nothing'.
completionContextGetEmpty ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if there are no proposals in the context
completionContextGetEmpty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionContext a) =>
a -> m Bool
completionContextGetEmpty a
self = 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 CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr CompletionContext -> IO CInt
gtk_source_completion_context_get_empty Ptr CompletionContext
self'
    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
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CompletionContextGetEmptyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsCompletionContext a) => O.OverloadedMethod CompletionContextGetEmptyMethodInfo a signature where
    overloadedMethod = completionContextGetEmpty

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


#endif

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

foreign import ccall "gtk_source_completion_context_get_language" gtk_source_completion_context_get_language :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    IO (Ptr GtkSource.Language.Language)

-- | Gets the language of the underlying buffer, if any.
completionContextGetLanguage ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m (Maybe GtkSource.Language.Language)
    -- ^ __Returns:__ a t'GI.GtkSource.Objects.Language.Language' or 'P.Nothing'
completionContextGetLanguage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionContext a) =>
a -> m (Maybe Language)
completionContextGetLanguage a
self = IO (Maybe Language) -> m (Maybe Language)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Language) -> m (Maybe Language))
-> IO (Maybe Language) -> m (Maybe Language)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Language
result <- Ptr CompletionContext -> IO (Ptr Language)
gtk_source_completion_context_get_language Ptr CompletionContext
self'
    Maybe Language
maybeResult <- Ptr Language
-> (Ptr Language -> IO Language) -> IO (Maybe Language)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Language
result ((Ptr Language -> IO Language) -> IO (Maybe Language))
-> (Ptr Language -> IO Language) -> IO (Maybe Language)
forall a b. (a -> b) -> a -> b
$ \Ptr Language
result' -> do
        Language
result'' <- ((ManagedPtr Language -> Language) -> Ptr Language -> IO Language
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Language -> Language
GtkSource.Language.Language) Ptr Language
result'
        Language -> IO Language
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Language
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Language -> IO (Maybe Language)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Language
maybeResult

#if defined(ENABLE_OVERLOADING)
data CompletionContextGetLanguageMethodInfo
instance (signature ~ (m (Maybe GtkSource.Language.Language)), MonadIO m, IsCompletionContext a) => O.OverloadedMethod CompletionContextGetLanguageMethodInfo a signature where
    overloadedMethod = completionContextGetLanguage

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


#endif

-- method CompletionContext::get_proposals_for_provider
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "provider"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "ListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_completion_context_get_proposals_for_provider" gtk_source_completion_context_get_proposals_for_provider :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    Ptr GtkSource.CompletionProvider.CompletionProvider -> -- provider : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    IO (Ptr Gio.ListModel.ListModel)

-- | Gets the t'GI.Gio.Interfaces.ListModel.ListModel' associated with the provider.
-- 
-- You can connect to t'GI.GtkSource.Objects.CompletionContext.CompletionContext'::@/model-changed/@ to receive
-- notifications about when the model has been replaced by a new model.
-- 
-- /Since: 5.6/
completionContextGetProposalsForProvider ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a, GtkSource.CompletionProvider.IsCompletionProvider b) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> b
    -- ^ /@provider@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.ListModel.ListModel' or 'P.Nothing'
completionContextGetProposalsForProvider :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCompletionContext a,
 IsCompletionProvider b) =>
a -> b -> m (Maybe ListModel)
completionContextGetProposalsForProvider a
self b
provider = IO (Maybe ListModel) -> m (Maybe ListModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CompletionProvider
provider' <- b -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
provider
    Ptr ListModel
result <- Ptr CompletionContext
-> Ptr CompletionProvider -> IO (Ptr ListModel)
gtk_source_completion_context_get_proposals_for_provider Ptr CompletionContext
self' Ptr CompletionProvider
provider'
    Maybe ListModel
maybeResult <- Ptr ListModel
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ListModel
result ((Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel))
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ \Ptr ListModel
result' -> do
        ListModel
result'' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result'
        ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
provider
    Maybe ListModel -> IO (Maybe ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListModel
maybeResult

#if defined(ENABLE_OVERLOADING)
data CompletionContextGetProposalsForProviderMethodInfo
instance (signature ~ (b -> m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsCompletionContext a, GtkSource.CompletionProvider.IsCompletionProvider b) => O.OverloadedMethod CompletionContextGetProposalsForProviderMethodInfo a signature where
    overloadedMethod = completionContextGetProposalsForProvider

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


#endif

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

foreign import ccall "gtk_source_completion_context_get_view" gtk_source_completion_context_get_view :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    IO (Ptr GtkSource.View.View)

-- | Gets the text view for the context.
completionContextGetView ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m (Maybe GtkSource.View.View)
    -- ^ __Returns:__ a t'GI.GtkSource.Objects.View.View' or 'P.Nothing'
completionContextGetView :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionContext a) =>
a -> m (Maybe View)
completionContextGetView a
self = IO (Maybe View) -> m (Maybe View)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe View) -> m (Maybe View))
-> IO (Maybe View) -> m (Maybe View)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr View
result <- Ptr CompletionContext -> IO (Ptr View)
gtk_source_completion_context_get_view Ptr CompletionContext
self'
    Maybe View
maybeResult <- Ptr View -> (Ptr View -> IO View) -> IO (Maybe View)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr View
result ((Ptr View -> IO View) -> IO (Maybe View))
-> (Ptr View -> IO View) -> IO (Maybe View)
forall a b. (a -> b) -> a -> b
$ \Ptr View
result' -> do
        View
result'' <- ((ManagedPtr View -> View) -> Ptr View -> IO View
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr View -> View
GtkSource.View.View) Ptr View
result'
        View -> IO View
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return View
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe View -> IO (Maybe View)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe View
maybeResult

#if defined(ENABLE_OVERLOADING)
data CompletionContextGetViewMethodInfo
instance (signature ~ (m (Maybe GtkSource.View.View)), MonadIO m, IsCompletionContext a) => O.OverloadedMethod CompletionContextGetViewMethodInfo a signature where
    overloadedMethod = completionContextGetView

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


#endif

-- method CompletionContext::get_word
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , 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_completion_context_get_word" gtk_source_completion_context_get_word :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    IO CString

-- | Gets the word that is being completed up to the position of the insert mark.
completionContextGetWord ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m T.Text
    -- ^ __Returns:__ a string containing the current word
completionContextGetWord :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionContext a) =>
a -> m Text
completionContextGetWord a
self = 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 CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr CompletionContext -> IO CString
gtk_source_completion_context_get_word Ptr CompletionContext
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"completionContextGetWord" 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
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CompletionContextGetWordMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsCompletionContext a) => O.OverloadedMethod CompletionContextGetWordMethodInfo a signature where
    overloadedMethod = completionContextGetWord

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


#endif

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

foreign import ccall "gtk_source_completion_context_list_providers" gtk_source_completion_context_list_providers :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    IO (Ptr Gio.ListModel.ListModel)

-- | Gets the providers that are associated with the context.
-- 
-- /Since: 5.6/
completionContextListProviders ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.ListModel.ListModel' of t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
completionContextListProviders :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionContext a) =>
a -> m ListModel
completionContextListProviders a
self = IO ListModel -> m ListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListModel -> m ListModel) -> IO ListModel -> m ListModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr CompletionContext -> IO (Ptr ListModel)
gtk_source_completion_context_list_providers Ptr CompletionContext
self'
    Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"completionContextListProviders" Ptr ListModel
result
    ListModel
result' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result'

#if defined(ENABLE_OVERLOADING)
data CompletionContextListProvidersMethodInfo
instance (signature ~ (m Gio.ListModel.ListModel), MonadIO m, IsCompletionContext a) => O.OverloadedMethod CompletionContextListProvidersMethodInfo a signature where
    overloadedMethod = completionContextListProviders

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


#endif

-- method CompletionContext::set_proposals_for_provider
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #GtkSourceCompletionContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "provider"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "results"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListModel or %NULL"
--                 , 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_completion_context_set_proposals_for_provider" gtk_source_completion_context_set_proposals_for_provider :: 
    Ptr CompletionContext ->                -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    Ptr GtkSource.CompletionProvider.CompletionProvider -> -- provider : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    Ptr Gio.ListModel.ListModel ->          -- results : TInterface (Name {namespace = "Gio", name = "ListModel"})
    IO ()

-- | This function allows providers to update their results for a context
-- outside of a call to [method/@completionProvider@/.populate_async].
-- 
-- This can be used to immediately return results for a provider while it does
-- additional asynchronous work. Doing so will allow the completions to
-- update while the operation is in progress.
completionContextSetProposalsForProvider ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionContext a, GtkSource.CompletionProvider.IsCompletionProvider b, Gio.ListModel.IsListModel c) =>
    a
    -- ^ /@self@/: an t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> b
    -- ^ /@provider@/: an t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> Maybe (c)
    -- ^ /@results@/: a t'GI.Gio.Interfaces.ListModel.ListModel' or 'P.Nothing'
    -> m ()
completionContextSetProposalsForProvider :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsCompletionContext a,
 IsCompletionProvider b, IsListModel c) =>
a -> b -> Maybe c -> m ()
completionContextSetProposalsForProvider a
self b
provider Maybe c
results = 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 CompletionContext
self' <- a -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CompletionProvider
provider' <- b -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
provider
    Ptr ListModel
maybeResults <- case Maybe c
results of
        Maybe c
Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
nullPtr
        Just c
jResults -> do
            Ptr ListModel
jResults' <- c -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jResults
            Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jResults'
    Ptr CompletionContext
-> Ptr CompletionProvider -> Ptr ListModel -> IO ()
gtk_source_completion_context_set_proposals_for_provider Ptr CompletionContext
self' Ptr CompletionProvider
provider' Ptr ListModel
maybeResults
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
provider
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
results c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionContextSetProposalsForProviderMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsCompletionContext a, GtkSource.CompletionProvider.IsCompletionProvider b, Gio.ListModel.IsListModel c) => O.OverloadedMethod CompletionContextSetProposalsForProviderMethodInfo a signature where
    overloadedMethod = completionContextSetProposalsForProvider

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


#endif