{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.GtkSource.Objects.SearchContext
    ( 

-- * Exported types
    SearchContext(..)                       ,
    IsSearchContext                         ,
    toSearchContext                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [backward]("GI.GtkSource.Objects.SearchContext#g:method:backward"), [backward2]("GI.GtkSource.Objects.SearchContext#g:method:backward2"), [backwardAsync]("GI.GtkSource.Objects.SearchContext#g:method:backwardAsync"), [backwardFinish]("GI.GtkSource.Objects.SearchContext#g:method:backwardFinish"), [backwardFinish2]("GI.GtkSource.Objects.SearchContext#g:method:backwardFinish2"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [forward]("GI.GtkSource.Objects.SearchContext#g:method:forward"), [forward2]("GI.GtkSource.Objects.SearchContext#g:method:forward2"), [forwardAsync]("GI.GtkSource.Objects.SearchContext#g:method:forwardAsync"), [forwardFinish]("GI.GtkSource.Objects.SearchContext#g:method:forwardFinish"), [forwardFinish2]("GI.GtkSource.Objects.SearchContext#g:method:forwardFinish2"), [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"), [replace]("GI.GtkSource.Objects.SearchContext#g:method:replace"), [replace2]("GI.GtkSource.Objects.SearchContext#g:method:replace2"), [replaceAll]("GI.GtkSource.Objects.SearchContext#g:method:replaceAll"), [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
-- [getBuffer]("GI.GtkSource.Objects.SearchContext#g:method:getBuffer"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getHighlight]("GI.GtkSource.Objects.SearchContext#g:method:getHighlight"), [getMatchStyle]("GI.GtkSource.Objects.SearchContext#g:method:getMatchStyle"), [getOccurrencePosition]("GI.GtkSource.Objects.SearchContext#g:method:getOccurrencePosition"), [getOccurrencesCount]("GI.GtkSource.Objects.SearchContext#g:method:getOccurrencesCount"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRegexError]("GI.GtkSource.Objects.SearchContext#g:method:getRegexError"), [getSettings]("GI.GtkSource.Objects.SearchContext#g:method:getSettings").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setHighlight]("GI.GtkSource.Objects.SearchContext#g:method:setHighlight"), [setMatchStyle]("GI.GtkSource.Objects.SearchContext#g:method:setMatchStyle"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSettings]("GI.GtkSource.Objects.SearchContext#g:method:setSettings").

#if defined(ENABLE_OVERLOADING)
    ResolveSearchContextMethod              ,
#endif

-- ** backward #method:backward#

#if defined(ENABLE_OVERLOADING)
    SearchContextBackwardMethodInfo         ,
#endif
    searchContextBackward                   ,


-- ** backward2 #method:backward2#

#if defined(ENABLE_OVERLOADING)
    SearchContextBackward2MethodInfo        ,
#endif
    searchContextBackward2                  ,


-- ** backwardAsync #method:backwardAsync#

#if defined(ENABLE_OVERLOADING)
    SearchContextBackwardAsyncMethodInfo    ,
#endif
    searchContextBackwardAsync              ,


-- ** backwardFinish #method:backwardFinish#

#if defined(ENABLE_OVERLOADING)
    SearchContextBackwardFinishMethodInfo   ,
#endif
    searchContextBackwardFinish             ,


-- ** backwardFinish2 #method:backwardFinish2#

#if defined(ENABLE_OVERLOADING)
    SearchContextBackwardFinish2MethodInfo  ,
#endif
    searchContextBackwardFinish2            ,


-- ** forward #method:forward#

#if defined(ENABLE_OVERLOADING)
    SearchContextForwardMethodInfo          ,
#endif
    searchContextForward                    ,


-- ** forward2 #method:forward2#

#if defined(ENABLE_OVERLOADING)
    SearchContextForward2MethodInfo         ,
#endif
    searchContextForward2                   ,


-- ** forwardAsync #method:forwardAsync#

#if defined(ENABLE_OVERLOADING)
    SearchContextForwardAsyncMethodInfo     ,
#endif
    searchContextForwardAsync               ,


-- ** forwardFinish #method:forwardFinish#

#if defined(ENABLE_OVERLOADING)
    SearchContextForwardFinishMethodInfo    ,
#endif
    searchContextForwardFinish              ,


-- ** forwardFinish2 #method:forwardFinish2#

#if defined(ENABLE_OVERLOADING)
    SearchContextForwardFinish2MethodInfo   ,
#endif
    searchContextForwardFinish2             ,


-- ** getBuffer #method:getBuffer#

#if defined(ENABLE_OVERLOADING)
    SearchContextGetBufferMethodInfo        ,
#endif
    searchContextGetBuffer                  ,


-- ** getHighlight #method:getHighlight#

#if defined(ENABLE_OVERLOADING)
    SearchContextGetHighlightMethodInfo     ,
#endif
    searchContextGetHighlight               ,


-- ** getMatchStyle #method:getMatchStyle#

#if defined(ENABLE_OVERLOADING)
    SearchContextGetMatchStyleMethodInfo    ,
#endif
    searchContextGetMatchStyle              ,


-- ** getOccurrencePosition #method:getOccurrencePosition#

#if defined(ENABLE_OVERLOADING)
    SearchContextGetOccurrencePositionMethodInfo,
#endif
    searchContextGetOccurrencePosition      ,


-- ** getOccurrencesCount #method:getOccurrencesCount#

#if defined(ENABLE_OVERLOADING)
    SearchContextGetOccurrencesCountMethodInfo,
#endif
    searchContextGetOccurrencesCount        ,


-- ** getRegexError #method:getRegexError#

#if defined(ENABLE_OVERLOADING)
    SearchContextGetRegexErrorMethodInfo    ,
#endif
    searchContextGetRegexError              ,


-- ** getSettings #method:getSettings#

#if defined(ENABLE_OVERLOADING)
    SearchContextGetSettingsMethodInfo      ,
#endif
    searchContextGetSettings                ,


-- ** new #method:new#

    searchContextNew                        ,


-- ** replace #method:replace#

#if defined(ENABLE_OVERLOADING)
    SearchContextReplaceMethodInfo          ,
#endif
    searchContextReplace                    ,


-- ** replace2 #method:replace2#

#if defined(ENABLE_OVERLOADING)
    SearchContextReplace2MethodInfo         ,
#endif
    searchContextReplace2                   ,


-- ** replaceAll #method:replaceAll#

#if defined(ENABLE_OVERLOADING)
    SearchContextReplaceAllMethodInfo       ,
#endif
    searchContextReplaceAll                 ,


-- ** setHighlight #method:setHighlight#

#if defined(ENABLE_OVERLOADING)
    SearchContextSetHighlightMethodInfo     ,
#endif
    searchContextSetHighlight               ,


-- ** setMatchStyle #method:setMatchStyle#

#if defined(ENABLE_OVERLOADING)
    SearchContextSetMatchStyleMethodInfo    ,
#endif
    searchContextSetMatchStyle              ,


-- ** setSettings #method:setSettings#

#if defined(ENABLE_OVERLOADING)
    SearchContextSetSettingsMethodInfo      ,
#endif
    searchContextSetSettings                ,




 -- * Properties


-- ** buffer #attr:buffer#
-- | The t'GI.GtkSource.Objects.Buffer.Buffer' associated to the search context.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    SearchContextBufferPropertyInfo         ,
#endif
    constructSearchContextBuffer            ,
    getSearchContextBuffer                  ,
#if defined(ENABLE_OVERLOADING)
    searchContextBuffer                     ,
#endif


-- ** highlight #attr:highlight#
-- | Highlight the search occurrences.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    SearchContextHighlightPropertyInfo      ,
#endif
    constructSearchContextHighlight         ,
    getSearchContextHighlight               ,
#if defined(ENABLE_OVERLOADING)
    searchContextHighlight                  ,
#endif
    setSearchContextHighlight               ,


-- ** matchStyle #attr:matchStyle#
-- | A t'GI.GtkSource.Objects.Style.Style', or 'P.Nothing' for theme\'s scheme default style.
-- 
-- /Since: 3.16/

#if defined(ENABLE_OVERLOADING)
    SearchContextMatchStylePropertyInfo     ,
#endif
    clearSearchContextMatchStyle            ,
    constructSearchContextMatchStyle        ,
    getSearchContextMatchStyle              ,
#if defined(ENABLE_OVERLOADING)
    searchContextMatchStyle                 ,
#endif
    setSearchContextMatchStyle              ,


-- ** occurrencesCount #attr:occurrencesCount#
-- | The total number of search occurrences. If the search is disabled,
-- the value is 0. If the buffer is not already fully scanned, the value
-- is -1.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    SearchContextOccurrencesCountPropertyInfo,
#endif
    getSearchContextOccurrencesCount        ,
#if defined(ENABLE_OVERLOADING)
    searchContextOccurrencesCount           ,
#endif


-- ** regexError #attr:regexError#
-- | If the regex search pattern doesn\'t follow all the rules, this
-- property will be set. If the pattern is valid, the value is 'P.Nothing'.
-- 
-- Free with 'GI.GLib.Structs.Error.errorFree'.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    SearchContextRegexErrorPropertyInfo     ,
#endif
    getSearchContextRegexError              ,
#if defined(ENABLE_OVERLOADING)
    searchContextRegexError                 ,
#endif


-- ** settings #attr:settings#
-- | The t'GI.GtkSource.Objects.SearchSettings.SearchSettings' associated to the search context.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    SearchContextSettingsPropertyInfo       ,
#endif
    clearSearchContextSettings              ,
    constructSearchContextSettings          ,
    getSearchContextSettings                ,
#if defined(ENABLE_OVERLOADING)
    searchContextSettings                   ,
#endif
    setSearchContextSettings                ,




    ) 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.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.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.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gtk.Structs.TextIter as Gtk.TextIter
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Buffer as GtkSource.Buffer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SearchSettings as GtkSource.SearchSettings
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Style as GtkSource.Style

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

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

foreign import ccall "gtk_source_search_context_get_type"
    c_gtk_source_search_context_get_type :: IO B.Types.GType

instance B.Types.TypedObject SearchContext where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_search_context_get_type

instance B.Types.GObject SearchContext

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSearchContextMethod (t :: Symbol) (o :: *) :: * where
    ResolveSearchContextMethod "backward" o = SearchContextBackwardMethodInfo
    ResolveSearchContextMethod "backward2" o = SearchContextBackward2MethodInfo
    ResolveSearchContextMethod "backwardAsync" o = SearchContextBackwardAsyncMethodInfo
    ResolveSearchContextMethod "backwardFinish" o = SearchContextBackwardFinishMethodInfo
    ResolveSearchContextMethod "backwardFinish2" o = SearchContextBackwardFinish2MethodInfo
    ResolveSearchContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSearchContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSearchContextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSearchContextMethod "forward" o = SearchContextForwardMethodInfo
    ResolveSearchContextMethod "forward2" o = SearchContextForward2MethodInfo
    ResolveSearchContextMethod "forwardAsync" o = SearchContextForwardAsyncMethodInfo
    ResolveSearchContextMethod "forwardFinish" o = SearchContextForwardFinishMethodInfo
    ResolveSearchContextMethod "forwardFinish2" o = SearchContextForwardFinish2MethodInfo
    ResolveSearchContextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSearchContextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSearchContextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSearchContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSearchContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSearchContextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSearchContextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSearchContextMethod "replace" o = SearchContextReplaceMethodInfo
    ResolveSearchContextMethod "replace2" o = SearchContextReplace2MethodInfo
    ResolveSearchContextMethod "replaceAll" o = SearchContextReplaceAllMethodInfo
    ResolveSearchContextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSearchContextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSearchContextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSearchContextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSearchContextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSearchContextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSearchContextMethod "getBuffer" o = SearchContextGetBufferMethodInfo
    ResolveSearchContextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSearchContextMethod "getHighlight" o = SearchContextGetHighlightMethodInfo
    ResolveSearchContextMethod "getMatchStyle" o = SearchContextGetMatchStyleMethodInfo
    ResolveSearchContextMethod "getOccurrencePosition" o = SearchContextGetOccurrencePositionMethodInfo
    ResolveSearchContextMethod "getOccurrencesCount" o = SearchContextGetOccurrencesCountMethodInfo
    ResolveSearchContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSearchContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSearchContextMethod "getRegexError" o = SearchContextGetRegexErrorMethodInfo
    ResolveSearchContextMethod "getSettings" o = SearchContextGetSettingsMethodInfo
    ResolveSearchContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSearchContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSearchContextMethod "setHighlight" o = SearchContextSetHighlightMethodInfo
    ResolveSearchContextMethod "setMatchStyle" o = SearchContextSetMatchStyleMethodInfo
    ResolveSearchContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSearchContextMethod "setSettings" o = SearchContextSetSettingsMethodInfo
    ResolveSearchContextMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

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

-- | Construct a `GValueConstruct` with valid value for the “@buffer@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSearchContextBuffer :: (IsSearchContext o, MIO.MonadIO m, GtkSource.Buffer.IsBuffer a) => a -> m (GValueConstruct o)
constructSearchContextBuffer :: forall o (m :: * -> *) a.
(IsSearchContext o, MonadIO m, IsBuffer a) =>
a -> m (GValueConstruct o)
constructSearchContextBuffer a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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
"buffer" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data SearchContextBufferPropertyInfo
instance AttrInfo SearchContextBufferPropertyInfo where
    type AttrAllowedOps SearchContextBufferPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SearchContextBufferPropertyInfo = IsSearchContext
    type AttrSetTypeConstraint SearchContextBufferPropertyInfo = GtkSource.Buffer.IsBuffer
    type AttrTransferTypeConstraint SearchContextBufferPropertyInfo = GtkSource.Buffer.IsBuffer
    type AttrTransferType SearchContextBufferPropertyInfo = GtkSource.Buffer.Buffer
    type AttrGetType SearchContextBufferPropertyInfo = GtkSource.Buffer.Buffer
    type AttrLabel SearchContextBufferPropertyInfo = "buffer"
    type AttrOrigin SearchContextBufferPropertyInfo = SearchContext
    attrGet = getSearchContextBuffer
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo GtkSource.Buffer.Buffer v
    attrConstruct = constructSearchContextBuffer
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SearchContext.buffer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.25/docs/GI-GtkSource-Objects-SearchContext.html#g:attr:buffer"
        })
#endif

-- VVV Prop "highlight"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@highlight@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' searchContext #highlight
-- @
getSearchContextHighlight :: (MonadIO m, IsSearchContext o) => o -> m Bool
getSearchContextHighlight :: forall (m :: * -> *) o.
(MonadIO m, IsSearchContext o) =>
o -> m Bool
getSearchContextHighlight o
obj = IO Bool -> m Bool
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
"highlight"

-- | Set the value of the “@highlight@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' searchContext [ #highlight 'Data.GI.Base.Attributes.:=' value ]
-- @
setSearchContextHighlight :: (MonadIO m, IsSearchContext o) => o -> Bool -> m ()
setSearchContextHighlight :: forall (m :: * -> *) o.
(MonadIO m, IsSearchContext o) =>
o -> Bool -> m ()
setSearchContextHighlight o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"highlight" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@highlight@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSearchContextHighlight :: (IsSearchContext o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSearchContextHighlight :: forall o (m :: * -> *).
(IsSearchContext o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructSearchContextHighlight Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"highlight" Bool
val

#if defined(ENABLE_OVERLOADING)
data SearchContextHighlightPropertyInfo
instance AttrInfo SearchContextHighlightPropertyInfo where
    type AttrAllowedOps SearchContextHighlightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SearchContextHighlightPropertyInfo = IsSearchContext
    type AttrSetTypeConstraint SearchContextHighlightPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SearchContextHighlightPropertyInfo = (~) Bool
    type AttrTransferType SearchContextHighlightPropertyInfo = Bool
    type AttrGetType SearchContextHighlightPropertyInfo = Bool
    type AttrLabel SearchContextHighlightPropertyInfo = "highlight"
    type AttrOrigin SearchContextHighlightPropertyInfo = SearchContext
    attrGet = getSearchContextHighlight
    attrSet = setSearchContextHighlight
    attrTransfer _ v = do
        return v
    attrConstruct = constructSearchContextHighlight
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SearchContext.highlight"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.25/docs/GI-GtkSource-Objects-SearchContext.html#g:attr:highlight"
        })
#endif

-- VVV Prop "match-style"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "Style"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just True)

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

-- | Set the value of the “@match-style@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' searchContext [ #matchStyle 'Data.GI.Base.Attributes.:=' value ]
-- @
setSearchContextMatchStyle :: (MonadIO m, IsSearchContext o, GtkSource.Style.IsStyle a) => o -> a -> m ()
setSearchContextMatchStyle :: forall (m :: * -> *) o a.
(MonadIO m, IsSearchContext o, IsStyle a) =>
o -> a -> m ()
setSearchContextMatchStyle o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"match-style" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@match-style@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSearchContextMatchStyle :: (IsSearchContext o, MIO.MonadIO m, GtkSource.Style.IsStyle a) => a -> m (GValueConstruct o)
constructSearchContextMatchStyle :: forall o (m :: * -> *) a.
(IsSearchContext o, MonadIO m, IsStyle a) =>
a -> m (GValueConstruct o)
constructSearchContextMatchStyle a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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
"match-style" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@match-style@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #matchStyle
-- @
clearSearchContextMatchStyle :: (MonadIO m, IsSearchContext o) => o -> m ()
clearSearchContextMatchStyle :: forall (m :: * -> *) o. (MonadIO m, IsSearchContext o) => o -> m ()
clearSearchContextMatchStyle o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Style -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"match-style" (Maybe Style
forall a. Maybe a
Nothing :: Maybe GtkSource.Style.Style)

#if defined(ENABLE_OVERLOADING)
data SearchContextMatchStylePropertyInfo
instance AttrInfo SearchContextMatchStylePropertyInfo where
    type AttrAllowedOps SearchContextMatchStylePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SearchContextMatchStylePropertyInfo = IsSearchContext
    type AttrSetTypeConstraint SearchContextMatchStylePropertyInfo = GtkSource.Style.IsStyle
    type AttrTransferTypeConstraint SearchContextMatchStylePropertyInfo = GtkSource.Style.IsStyle
    type AttrTransferType SearchContextMatchStylePropertyInfo = GtkSource.Style.Style
    type AttrGetType SearchContextMatchStylePropertyInfo = GtkSource.Style.Style
    type AttrLabel SearchContextMatchStylePropertyInfo = "match-style"
    type AttrOrigin SearchContextMatchStylePropertyInfo = SearchContext
    attrGet = getSearchContextMatchStyle
    attrSet = setSearchContextMatchStyle
    attrTransfer _ v = do
        unsafeCastTo GtkSource.Style.Style v
    attrConstruct = constructSearchContextMatchStyle
    attrClear = clearSearchContextMatchStyle
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SearchContext.matchStyle"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.25/docs/GI-GtkSource-Objects-SearchContext.html#g:attr:matchStyle"
        })
#endif

-- VVV Prop "occurrences-count"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data SearchContextOccurrencesCountPropertyInfo
instance AttrInfo SearchContextOccurrencesCountPropertyInfo where
    type AttrAllowedOps SearchContextOccurrencesCountPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SearchContextOccurrencesCountPropertyInfo = IsSearchContext
    type AttrSetTypeConstraint SearchContextOccurrencesCountPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SearchContextOccurrencesCountPropertyInfo = (~) ()
    type AttrTransferType SearchContextOccurrencesCountPropertyInfo = ()
    type AttrGetType SearchContextOccurrencesCountPropertyInfo = Int32
    type AttrLabel SearchContextOccurrencesCountPropertyInfo = "occurrences-count"
    type AttrOrigin SearchContextOccurrencesCountPropertyInfo = SearchContext
    attrGet = getSearchContextOccurrencesCount
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SearchContext.occurrencesCount"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.25/docs/GI-GtkSource-Objects-SearchContext.html#g:attr:occurrencesCount"
        })
#endif

-- VVV Prop "regex-error"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data SearchContextRegexErrorPropertyInfo
instance AttrInfo SearchContextRegexErrorPropertyInfo where
    type AttrAllowedOps SearchContextRegexErrorPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SearchContextRegexErrorPropertyInfo = IsSearchContext
    type AttrSetTypeConstraint SearchContextRegexErrorPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SearchContextRegexErrorPropertyInfo = (~) ()
    type AttrTransferType SearchContextRegexErrorPropertyInfo = ()
    type AttrGetType SearchContextRegexErrorPropertyInfo = (Ptr ())
    type AttrLabel SearchContextRegexErrorPropertyInfo = "regex-error"
    type AttrOrigin SearchContextRegexErrorPropertyInfo = SearchContext
    attrGet = getSearchContextRegexError
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SearchContext.regexError"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.25/docs/GI-GtkSource-Objects-SearchContext.html#g:attr:regexError"
        })
#endif

-- VVV Prop "settings"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just True)

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

-- | Set the value of the “@settings@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' searchContext [ #settings 'Data.GI.Base.Attributes.:=' value ]
-- @
setSearchContextSettings :: (MonadIO m, IsSearchContext o, GtkSource.SearchSettings.IsSearchSettings a) => o -> a -> m ()
setSearchContextSettings :: forall (m :: * -> *) o a.
(MonadIO m, IsSearchContext o, IsSearchSettings a) =>
o -> a -> m ()
setSearchContextSettings o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"settings" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@settings@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSearchContextSettings :: (IsSearchContext o, MIO.MonadIO m, GtkSource.SearchSettings.IsSearchSettings a) => a -> m (GValueConstruct o)
constructSearchContextSettings :: forall o (m :: * -> *) a.
(IsSearchContext o, MonadIO m, IsSearchSettings a) =>
a -> m (GValueConstruct o)
constructSearchContextSettings a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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
"settings" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@settings@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #settings
-- @
clearSearchContextSettings :: (MonadIO m, IsSearchContext o) => o -> m ()
clearSearchContextSettings :: forall (m :: * -> *) o. (MonadIO m, IsSearchContext o) => o -> m ()
clearSearchContextSettings o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe SearchSettings -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"settings" (Maybe SearchSettings
forall a. Maybe a
Nothing :: Maybe GtkSource.SearchSettings.SearchSettings)

#if defined(ENABLE_OVERLOADING)
data SearchContextSettingsPropertyInfo
instance AttrInfo SearchContextSettingsPropertyInfo where
    type AttrAllowedOps SearchContextSettingsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SearchContextSettingsPropertyInfo = IsSearchContext
    type AttrSetTypeConstraint SearchContextSettingsPropertyInfo = GtkSource.SearchSettings.IsSearchSettings
    type AttrTransferTypeConstraint SearchContextSettingsPropertyInfo = GtkSource.SearchSettings.IsSearchSettings
    type AttrTransferType SearchContextSettingsPropertyInfo = GtkSource.SearchSettings.SearchSettings
    type AttrGetType SearchContextSettingsPropertyInfo = GtkSource.SearchSettings.SearchSettings
    type AttrLabel SearchContextSettingsPropertyInfo = "settings"
    type AttrOrigin SearchContextSettingsPropertyInfo = SearchContext
    attrGet = getSearchContextSettings
    attrSet = setSearchContextSettings
    attrTransfer _ v = do
        unsafeCastTo GtkSource.SearchSettings.SearchSettings v
    attrConstruct = constructSearchContextSettings
    attrClear = clearSearchContextSettings
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SearchContext.settings"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.25/docs/GI-GtkSource-Objects-SearchContext.html#g:attr:settings"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SearchContext
type instance O.AttributeList SearchContext = SearchContextAttributeList
type SearchContextAttributeList = ('[ '("buffer", SearchContextBufferPropertyInfo), '("highlight", SearchContextHighlightPropertyInfo), '("matchStyle", SearchContextMatchStylePropertyInfo), '("occurrencesCount", SearchContextOccurrencesCountPropertyInfo), '("regexError", SearchContextRegexErrorPropertyInfo), '("settings", SearchContextSettingsPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
searchContextBuffer :: AttrLabelProxy "buffer"
searchContextBuffer = AttrLabelProxy

searchContextHighlight :: AttrLabelProxy "highlight"
searchContextHighlight = AttrLabelProxy

searchContextMatchStyle :: AttrLabelProxy "matchStyle"
searchContextMatchStyle = AttrLabelProxy

searchContextOccurrencesCount :: AttrLabelProxy "occurrencesCount"
searchContextOccurrencesCount = AttrLabelProxy

searchContextRegexError :: AttrLabelProxy "regexError"
searchContextRegexError = AttrLabelProxy

searchContextSettings :: AttrLabelProxy "settings"
searchContextSettings = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SearchContext = SearchContextSignalList
type SearchContextSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method SearchContext::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceBuffer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkSource" , name = "SearchContext" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_new" gtk_source_search_context_new :: 
    Ptr GtkSource.Buffer.Buffer ->          -- buffer : TInterface (Name {namespace = "GtkSource", name = "Buffer"})
    Ptr GtkSource.SearchSettings.SearchSettings -> -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    IO (Ptr SearchContext)

-- | Creates a new search context, associated with /@buffer@/, and customized with
-- /@settings@/. If /@settings@/ is 'P.Nothing', a new t'GI.GtkSource.Objects.SearchSettings.SearchSettings' object will
-- be created, that you can retrieve with
-- 'GI.GtkSource.Objects.SearchContext.searchContextGetSettings'.
-- 
-- /Since: 3.10/
searchContextNew ::
    (B.CallStack.HasCallStack, MonadIO m, GtkSource.Buffer.IsBuffer a, GtkSource.SearchSettings.IsSearchSettings b) =>
    a
    -- ^ /@buffer@/: a t'GI.GtkSource.Objects.Buffer.Buffer'.
    -> Maybe (b)
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings', or 'P.Nothing'.
    -> m SearchContext
    -- ^ __Returns:__ a new search context.
searchContextNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBuffer a, IsSearchSettings b) =>
a -> Maybe b -> m SearchContext
searchContextNew a
buffer Maybe b
settings = IO SearchContext -> m SearchContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SearchContext -> m SearchContext)
-> IO SearchContext -> m SearchContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- a -> IO (Ptr Buffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr SearchSettings
maybeSettings <- case Maybe b
settings of
        Maybe b
Nothing -> Ptr SearchSettings -> IO (Ptr SearchSettings)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SearchSettings
forall a. Ptr a
nullPtr
        Just b
jSettings -> do
            Ptr SearchSettings
jSettings' <- b -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSettings
            Ptr SearchSettings -> IO (Ptr SearchSettings)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SearchSettings
jSettings'
    Ptr SearchContext
result <- Ptr Buffer -> Ptr SearchSettings -> IO (Ptr SearchContext)
gtk_source_search_context_new Ptr Buffer
buffer' Ptr SearchSettings
maybeSettings
    Text -> Ptr SearchContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"searchContextNew" Ptr SearchContext
result
    SearchContext
result' <- ((ManagedPtr SearchContext -> SearchContext)
-> Ptr SearchContext -> IO SearchContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SearchContext -> SearchContext
SearchContext) Ptr SearchContext
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
settings b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    SearchContext -> IO SearchContext
forall (m :: * -> *) a. Monad m => a -> m a
return SearchContext
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SearchContext::backward
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of search." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for start of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for end of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_backward" gtk_source_search_context_backward :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gtk.TextIter.TextIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO CInt

{-# DEPRECATED searchContextBackward ["(Since version 3.22)","Use 'GI.GtkSource.Objects.SearchContext.searchContextBackward2' instead."] #-}
-- | Synchronous backward search. It is recommended to use the asynchronous
-- functions instead, to not block the user interface. However, if you are sure
-- that the /@buffer@/ is small, this function is more convenient to use.
-- 
-- /Since: 3.10/
searchContextBackward ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: start of search.
    -> m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))
    -- ^ __Returns:__ whether a match was found.
searchContextBackward :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> TextIter -> m (Bool, TextIter, TextIter)
searchContextBackward a
search TextIter
iter = IO (Bool, TextIter, TextIter) -> m (Bool, TextIter, TextIter)
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 SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    Ptr TextIter
matchStart <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter
matchEnd <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    CInt
result <- Ptr SearchContext
-> Ptr TextIter -> Ptr TextIter -> Ptr TextIter -> IO CInt
gtk_source_search_context_backward Ptr SearchContext
search' Ptr TextIter
iter' Ptr TextIter
matchStart Ptr TextIter
matchEnd
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TextIter
matchStart' <- ((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
matchStart
    TextIter
matchEnd' <- ((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
matchEnd
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
    (Bool, TextIter, TextIter) -> IO (Bool, TextIter, TextIter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', TextIter
matchStart', TextIter
matchEnd')

#if defined(ENABLE_OVERLOADING)
data SearchContextBackwardMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextBackwardMethodInfo a signature where
    overloadedMethod = searchContextBackward

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


#endif

-- method SearchContext::backward2
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of search." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for start of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for end of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "has_wrapped_around"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location to know whether the\n  search has wrapped around, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_backward2" gtk_source_search_context_backward2 :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gtk.TextIter.TextIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr CInt ->                             -- has_wrapped_around : TBasicType TBoolean
    IO CInt

-- | Synchronous backward search. It is recommended to use the asynchronous
-- functions instead, to not block the user interface. However, if you are sure
-- that the /@buffer@/ is small, this function is more convenient to use.
-- 
-- The difference with 'GI.GtkSource.Objects.SearchContext.searchContextBackward' is that the
-- /@hasWrappedAround@/ out parameter has been added for convenience.
-- 
-- If the t'GI.GtkSource.Objects.SearchSettings.SearchSettings':@/wrap-around/@ property is 'P.False', this function
-- doesn\'t try to wrap around.
-- 
-- The /@hasWrappedAround@/ out parameter is set independently of whether a match
-- is found. So if this function returns 'P.False', /@hasWrappedAround@/ will have
-- the same value as the t'GI.GtkSource.Objects.SearchSettings.SearchSettings':@/wrap-around/@ property.
-- 
-- /Since: 3.22/
searchContextBackward2 ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: start of search.
    -> m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter, Bool))
    -- ^ __Returns:__ whether a match was found.
searchContextBackward2 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> TextIter -> m (Bool, TextIter, TextIter, Bool)
searchContextBackward2 a
search TextIter
iter = IO (Bool, TextIter, TextIter, Bool)
-> m (Bool, TextIter, TextIter, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, TextIter, TextIter, Bool)
 -> m (Bool, TextIter, TextIter, Bool))
-> IO (Bool, TextIter, TextIter, Bool)
-> m (Bool, TextIter, TextIter, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    Ptr TextIter
matchStart <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter
matchEnd <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr CInt
hasWrappedAround <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr SearchContext
-> Ptr TextIter
-> Ptr TextIter
-> Ptr TextIter
-> Ptr CInt
-> IO CInt
gtk_source_search_context_backward2 Ptr SearchContext
search' Ptr TextIter
iter' Ptr TextIter
matchStart Ptr TextIter
matchEnd Ptr CInt
hasWrappedAround
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TextIter
matchStart' <- ((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
matchStart
    TextIter
matchEnd' <- ((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
matchEnd
    CInt
hasWrappedAround' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hasWrappedAround
    let hasWrappedAround'' :: Bool
hasWrappedAround'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
hasWrappedAround'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
hasWrappedAround
    (Bool, TextIter, TextIter, Bool)
-> IO (Bool, TextIter, TextIter, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', TextIter
matchStart', TextIter
matchEnd', Bool
hasWrappedAround'')

#if defined(ENABLE_OVERLOADING)
data SearchContextBackward2MethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter, Bool))), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextBackward2MethodInfo a signature where
    overloadedMethod = searchContextBackward2

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


#endif

-- method SearchContext::backward_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of search." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncReadyCallback to call when the operation is finished."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the @callback function."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_backward_async" gtk_source_search_context_backward_async :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gtk.TextIter.TextIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | The asynchronous version of 'GI.GtkSource.Objects.SearchContext.searchContextBackward2'.
-- 
-- See the documentation of 'GI.GtkSource.Objects.SearchContext.searchContextBackward2' for more
-- details.
-- 
-- See the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' documentation to know how to use this function.
-- 
-- If the operation is cancelled, the /@callback@/ will only be called if
-- /@cancellable@/ was not 'P.Nothing'. 'GI.GtkSource.Objects.SearchContext.searchContextBackwardAsync' takes
-- ownership of /@cancellable@/, so you can unref it after calling this function.
-- 
-- /Since: 3.10/
searchContextBackwardAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: start of search.
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the operation is finished.
    -> m ()
searchContextBackwardAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSearchContext a, IsCancellable b) =>
a -> TextIter -> Maybe b -> Maybe AsyncReadyCallback -> m ()
searchContextBackwardAsync a
search TextIter
iter Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr SearchContext
-> Ptr TextIter
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_source_search_context_backward_async Ptr SearchContext
search' Ptr TextIter
iter' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SearchContextBackwardAsyncMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSearchContext a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SearchContextBackwardAsyncMethodInfo a signature where
    overloadedMethod = searchContextBackwardAsync

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


#endif

-- method SearchContext::backward_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for start of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for end of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gtk_source_search_context_backward_finish" gtk_source_search_context_backward_finish :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED searchContextBackwardFinish ["(Since version 3.22)","Use 'GI.GtkSource.Objects.SearchContext.searchContextBackwardFinish2' instead."] #-}
-- | Finishes a backward search started with
-- 'GI.GtkSource.Objects.SearchContext.searchContextBackwardAsync'.
-- 
-- /Since: 3.10/
searchContextBackwardFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ((Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
searchContextBackwardFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSearchContext a, IsAsyncResult b) =>
a -> b -> m (TextIter, TextIter)
searchContextBackwardFinish a
search b
result_ = IO (TextIter, TextIter) -> m (TextIter, TextIter)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TextIter, TextIter) -> m (TextIter, TextIter))
-> IO (TextIter, TextIter) -> m (TextIter, TextIter)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr TextIter
matchStart <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter
matchEnd <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    IO (TextIter, TextIter) -> IO () -> IO (TextIter, TextIter)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr SearchContext
-> Ptr AsyncResult
-> Ptr TextIter
-> Ptr TextIter
-> Ptr (Ptr GError)
-> IO CInt
gtk_source_search_context_backward_finish Ptr SearchContext
search' Ptr AsyncResult
result_' Ptr TextIter
matchStart Ptr TextIter
matchEnd
        TextIter
matchStart' <- ((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
matchStart
        TextIter
matchEnd' <- ((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
matchEnd
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        (TextIter, TextIter) -> IO (TextIter, TextIter)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextIter
matchStart', TextIter
matchEnd')
     ) (do
        Ptr TextIter -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr TextIter
matchStart
        Ptr TextIter -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr TextIter
matchEnd
     )

#if defined(ENABLE_OVERLOADING)
data SearchContextBackwardFinishMethodInfo
instance (signature ~ (b -> m ((Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))), MonadIO m, IsSearchContext a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SearchContextBackwardFinishMethodInfo a signature where
    overloadedMethod = searchContextBackwardFinish

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


#endif

-- method SearchContext::backward_finish2
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for start of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for end of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "has_wrapped_around"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location to know whether the\n  search has wrapped around, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gtk_source_search_context_backward_finish2" gtk_source_search_context_backward_finish2 :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr CInt ->                             -- has_wrapped_around : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a backward search started with
-- 'GI.GtkSource.Objects.SearchContext.searchContextBackwardAsync'.
-- 
-- See the documentation of 'GI.GtkSource.Objects.SearchContext.searchContextBackward2' for more
-- details.
-- 
-- /Since: 3.22/
searchContextBackwardFinish2 ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ((Gtk.TextIter.TextIter, Gtk.TextIter.TextIter, Bool))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
searchContextBackwardFinish2 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSearchContext a, IsAsyncResult b) =>
a -> b -> m (TextIter, TextIter, Bool)
searchContextBackwardFinish2 a
search b
result_ = IO (TextIter, TextIter, Bool) -> m (TextIter, TextIter, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TextIter, TextIter, Bool) -> m (TextIter, TextIter, Bool))
-> IO (TextIter, TextIter, Bool) -> m (TextIter, TextIter, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr TextIter
matchStart <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter
matchEnd <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr CInt
hasWrappedAround <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO (TextIter, TextIter, Bool)
-> IO () -> IO (TextIter, TextIter, Bool)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr SearchContext
-> Ptr AsyncResult
-> Ptr TextIter
-> Ptr TextIter
-> Ptr CInt
-> Ptr (Ptr GError)
-> IO CInt
gtk_source_search_context_backward_finish2 Ptr SearchContext
search' Ptr AsyncResult
result_' Ptr TextIter
matchStart Ptr TextIter
matchEnd Ptr CInt
hasWrappedAround
        TextIter
matchStart' <- ((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
matchStart
        TextIter
matchEnd' <- ((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
matchEnd
        CInt
hasWrappedAround' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hasWrappedAround
        let hasWrappedAround'' :: Bool
hasWrappedAround'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
hasWrappedAround'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
hasWrappedAround
        (TextIter, TextIter, Bool) -> IO (TextIter, TextIter, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextIter
matchStart', TextIter
matchEnd', Bool
hasWrappedAround'')
     ) (do
        Ptr TextIter -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr TextIter
matchStart
        Ptr TextIter -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr TextIter
matchEnd
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
hasWrappedAround
     )

#if defined(ENABLE_OVERLOADING)
data SearchContextBackwardFinish2MethodInfo
instance (signature ~ (b -> m ((Gtk.TextIter.TextIter, Gtk.TextIter.TextIter, Bool))), MonadIO m, IsSearchContext a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SearchContextBackwardFinish2MethodInfo a signature where
    overloadedMethod = searchContextBackwardFinish2

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


#endif

-- method SearchContext::forward
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of search." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for start of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for end of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_forward" gtk_source_search_context_forward :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gtk.TextIter.TextIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO CInt

{-# DEPRECATED searchContextForward ["(Since version 3.22)","Use 'GI.GtkSource.Objects.SearchContext.searchContextForward2' instead."] #-}
-- | Synchronous forward search. It is recommended to use the asynchronous
-- functions instead, to not block the user interface. However, if you are sure
-- that the /@buffer@/ is small, this function is more convenient to use.
-- 
-- /Since: 3.10/
searchContextForward ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: start of search.
    -> m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))
    -- ^ __Returns:__ whether a match was found.
searchContextForward :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> TextIter -> m (Bool, TextIter, TextIter)
searchContextForward a
search TextIter
iter = IO (Bool, TextIter, TextIter) -> m (Bool, TextIter, TextIter)
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 SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    Ptr TextIter
matchStart <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter
matchEnd <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    CInt
result <- Ptr SearchContext
-> Ptr TextIter -> Ptr TextIter -> Ptr TextIter -> IO CInt
gtk_source_search_context_forward Ptr SearchContext
search' Ptr TextIter
iter' Ptr TextIter
matchStart Ptr TextIter
matchEnd
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TextIter
matchStart' <- ((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
matchStart
    TextIter
matchEnd' <- ((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
matchEnd
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
    (Bool, TextIter, TextIter) -> IO (Bool, TextIter, TextIter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', TextIter
matchStart', TextIter
matchEnd')

#if defined(ENABLE_OVERLOADING)
data SearchContextForwardMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextForwardMethodInfo a signature where
    overloadedMethod = searchContextForward

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


#endif

-- method SearchContext::forward2
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of search." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for start of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for end of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "has_wrapped_around"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location to know whether the\n  search has wrapped around, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_forward2" gtk_source_search_context_forward2 :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gtk.TextIter.TextIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr CInt ->                             -- has_wrapped_around : TBasicType TBoolean
    IO CInt

-- | Synchronous forward search. It is recommended to use the asynchronous
-- functions instead, to not block the user interface. However, if you are sure
-- that the /@buffer@/ is small, this function is more convenient to use.
-- 
-- The difference with 'GI.GtkSource.Objects.SearchContext.searchContextForward' is that the
-- /@hasWrappedAround@/ out parameter has been added for convenience.
-- 
-- If the t'GI.GtkSource.Objects.SearchSettings.SearchSettings':@/wrap-around/@ property is 'P.False', this function
-- doesn\'t try to wrap around.
-- 
-- The /@hasWrappedAround@/ out parameter is set independently of whether a match
-- is found. So if this function returns 'P.False', /@hasWrappedAround@/ will have
-- the same value as the t'GI.GtkSource.Objects.SearchSettings.SearchSettings':@/wrap-around/@ property.
-- 
-- /Since: 3.22/
searchContextForward2 ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: start of search.
    -> m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter, Bool))
    -- ^ __Returns:__ whether a match was found.
searchContextForward2 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> TextIter -> m (Bool, TextIter, TextIter, Bool)
searchContextForward2 a
search TextIter
iter = IO (Bool, TextIter, TextIter, Bool)
-> m (Bool, TextIter, TextIter, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, TextIter, TextIter, Bool)
 -> m (Bool, TextIter, TextIter, Bool))
-> IO (Bool, TextIter, TextIter, Bool)
-> m (Bool, TextIter, TextIter, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    Ptr TextIter
matchStart <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter
matchEnd <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr CInt
hasWrappedAround <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr SearchContext
-> Ptr TextIter
-> Ptr TextIter
-> Ptr TextIter
-> Ptr CInt
-> IO CInt
gtk_source_search_context_forward2 Ptr SearchContext
search' Ptr TextIter
iter' Ptr TextIter
matchStart Ptr TextIter
matchEnd Ptr CInt
hasWrappedAround
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TextIter
matchStart' <- ((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
matchStart
    TextIter
matchEnd' <- ((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
matchEnd
    CInt
hasWrappedAround' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hasWrappedAround
    let hasWrappedAround'' :: Bool
hasWrappedAround'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
hasWrappedAround'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
hasWrappedAround
    (Bool, TextIter, TextIter, Bool)
-> IO (Bool, TextIter, TextIter, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', TextIter
matchStart', TextIter
matchEnd', Bool
hasWrappedAround'')

#if defined(ENABLE_OVERLOADING)
data SearchContextForward2MethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter, Bool))), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextForward2MethodInfo a signature where
    overloadedMethod = searchContextForward2

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


#endif

-- method SearchContext::forward_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of search." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncReadyCallback to call when the operation is finished."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the @callback function."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_forward_async" gtk_source_search_context_forward_async :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gtk.TextIter.TextIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | The asynchronous version of 'GI.GtkSource.Objects.SearchContext.searchContextForward2'.
-- 
-- See the documentation of 'GI.GtkSource.Objects.SearchContext.searchContextForward2' for more
-- details.
-- 
-- See the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' documentation to know how to use this function.
-- 
-- If the operation is cancelled, the /@callback@/ will only be called if
-- /@cancellable@/ was not 'P.Nothing'. 'GI.GtkSource.Objects.SearchContext.searchContextForwardAsync' takes
-- ownership of /@cancellable@/, so you can unref it after calling this function.
-- 
-- /Since: 3.10/
searchContextForwardAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: start of search.
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the operation is finished.
    -> m ()
searchContextForwardAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSearchContext a, IsCancellable b) =>
a -> TextIter -> Maybe b -> Maybe AsyncReadyCallback -> m ()
searchContextForwardAsync a
search TextIter
iter Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr SearchContext
-> Ptr TextIter
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_source_search_context_forward_async Ptr SearchContext
search' Ptr TextIter
iter' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SearchContextForwardAsyncMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSearchContext a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SearchContextForwardAsyncMethodInfo a signature where
    overloadedMethod = searchContextForwardAsync

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


#endif

-- method SearchContext::forward_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for start of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for end of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gtk_source_search_context_forward_finish" gtk_source_search_context_forward_finish :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED searchContextForwardFinish ["(Since version 3.22)","Use 'GI.GtkSource.Objects.SearchContext.searchContextForwardFinish2' instead."] #-}
-- | Finishes a forward search started with
-- 'GI.GtkSource.Objects.SearchContext.searchContextForwardAsync'.
-- 
-- /Since: 3.10/
searchContextForwardFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ((Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
searchContextForwardFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSearchContext a, IsAsyncResult b) =>
a -> b -> m (TextIter, TextIter)
searchContextForwardFinish a
search b
result_ = IO (TextIter, TextIter) -> m (TextIter, TextIter)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TextIter, TextIter) -> m (TextIter, TextIter))
-> IO (TextIter, TextIter) -> m (TextIter, TextIter)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr TextIter
matchStart <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter
matchEnd <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    IO (TextIter, TextIter) -> IO () -> IO (TextIter, TextIter)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr SearchContext
-> Ptr AsyncResult
-> Ptr TextIter
-> Ptr TextIter
-> Ptr (Ptr GError)
-> IO CInt
gtk_source_search_context_forward_finish Ptr SearchContext
search' Ptr AsyncResult
result_' Ptr TextIter
matchStart Ptr TextIter
matchEnd
        TextIter
matchStart' <- ((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
matchStart
        TextIter
matchEnd' <- ((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
matchEnd
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        (TextIter, TextIter) -> IO (TextIter, TextIter)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextIter
matchStart', TextIter
matchEnd')
     ) (do
        Ptr TextIter -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr TextIter
matchStart
        Ptr TextIter -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr TextIter
matchEnd
     )

#if defined(ENABLE_OVERLOADING)
data SearchContextForwardFinishMethodInfo
instance (signature ~ (b -> m ((Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))), MonadIO m, IsSearchContext a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SearchContextForwardFinishMethodInfo a signature where
    overloadedMethod = searchContextForwardFinish

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


#endif

-- method SearchContext::forward_finish2
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for start of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for end of match, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "has_wrapped_around"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location to know whether the\n  search has wrapped around, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gtk_source_search_context_forward_finish2" gtk_source_search_context_forward_finish2 :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr CInt ->                             -- has_wrapped_around : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a forward search started with
-- 'GI.GtkSource.Objects.SearchContext.searchContextForwardAsync'.
-- 
-- See the documentation of 'GI.GtkSource.Objects.SearchContext.searchContextForward2' for more
-- details.
-- 
-- /Since: 3.22/
searchContextForwardFinish2 ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ((Gtk.TextIter.TextIter, Gtk.TextIter.TextIter, Bool))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
searchContextForwardFinish2 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSearchContext a, IsAsyncResult b) =>
a -> b -> m (TextIter, TextIter, Bool)
searchContextForwardFinish2 a
search b
result_ = IO (TextIter, TextIter, Bool) -> m (TextIter, TextIter, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TextIter, TextIter, Bool) -> m (TextIter, TextIter, Bool))
-> IO (TextIter, TextIter, Bool) -> m (TextIter, TextIter, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr TextIter
matchStart <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter
matchEnd <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr CInt
hasWrappedAround <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO (TextIter, TextIter, Bool)
-> IO () -> IO (TextIter, TextIter, Bool)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr SearchContext
-> Ptr AsyncResult
-> Ptr TextIter
-> Ptr TextIter
-> Ptr CInt
-> Ptr (Ptr GError)
-> IO CInt
gtk_source_search_context_forward_finish2 Ptr SearchContext
search' Ptr AsyncResult
result_' Ptr TextIter
matchStart Ptr TextIter
matchEnd Ptr CInt
hasWrappedAround
        TextIter
matchStart' <- ((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
matchStart
        TextIter
matchEnd' <- ((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
matchEnd
        CInt
hasWrappedAround' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hasWrappedAround
        let hasWrappedAround'' :: Bool
hasWrappedAround'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
hasWrappedAround'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
hasWrappedAround
        (TextIter, TextIter, Bool) -> IO (TextIter, TextIter, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextIter
matchStart', TextIter
matchEnd', Bool
hasWrappedAround'')
     ) (do
        Ptr TextIter -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr TextIter
matchStart
        Ptr TextIter -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr TextIter
matchEnd
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
hasWrappedAround
     )

#if defined(ENABLE_OVERLOADING)
data SearchContextForwardFinish2MethodInfo
instance (signature ~ (b -> m ((Gtk.TextIter.TextIter, Gtk.TextIter.TextIter, Bool))), MonadIO m, IsSearchContext a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SearchContextForwardFinish2MethodInfo a signature where
    overloadedMethod = searchContextForwardFinish2

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


#endif

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

foreign import ccall "gtk_source_search_context_get_buffer" gtk_source_search_context_get_buffer :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    IO (Ptr GtkSource.Buffer.Buffer)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.10/
searchContextGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> m GtkSource.Buffer.Buffer
    -- ^ __Returns:__ the associated buffer.
searchContextGetBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> m Buffer
searchContextGetBuffer a
search = IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr Buffer
result <- Ptr SearchContext -> IO (Ptr Buffer)
gtk_source_search_context_get_buffer Ptr SearchContext
search'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"searchContextGetBuffer" Ptr Buffer
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data SearchContextGetBufferMethodInfo
instance (signature ~ (m GtkSource.Buffer.Buffer), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextGetBufferMethodInfo a signature where
    overloadedMethod = searchContextGetBuffer

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


#endif

-- method SearchContext::get_highlight
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_get_highlight" gtk_source_search_context_get_highlight :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.10/
searchContextGetHighlight ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> m Bool
    -- ^ __Returns:__ whether to highlight the search occurrences.
searchContextGetHighlight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> m Bool
searchContextGetHighlight a
search = IO Bool -> m Bool
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 SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    CInt
result <- Ptr SearchContext -> IO CInt
gtk_source_search_context_get_highlight Ptr SearchContext
search'
    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
search
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SearchContextGetHighlightMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextGetHighlightMethodInfo a signature where
    overloadedMethod = searchContextGetHighlight

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


#endif

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

foreign import ccall "gtk_source_search_context_get_match_style" gtk_source_search_context_get_match_style :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    IO (Ptr GtkSource.Style.Style)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.16/
searchContextGetMatchStyle ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> m GtkSource.Style.Style
    -- ^ __Returns:__ the t'GI.GtkSource.Objects.Style.Style' to apply on search matches.
searchContextGetMatchStyle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> m Style
searchContextGetMatchStyle a
search = IO Style -> m Style
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Style -> m Style) -> IO Style -> m Style
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr Style
result <- Ptr SearchContext -> IO (Ptr Style)
gtk_source_search_context_get_match_style Ptr SearchContext
search'
    Text -> Ptr Style -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"searchContextGetMatchStyle" Ptr Style
result
    Style
result' <- ((ManagedPtr Style -> Style) -> Ptr Style -> IO Style
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Style -> Style
GtkSource.Style.Style) Ptr Style
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    Style -> IO Style
forall (m :: * -> *) a. Monad m => a -> m a
return Style
result'

#if defined(ENABLE_OVERLOADING)
data SearchContextGetMatchStyleMethodInfo
instance (signature ~ (m GtkSource.Style.Style), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextGetMatchStyleMethodInfo a signature where
    overloadedMethod = searchContextGetMatchStyle

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


#endif

-- method SearchContext::get_occurrence_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start of the occurrence."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the end of the occurrence."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_get_occurrence_position" gtk_source_search_context_get_occurrence_position :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO Int32

-- | Gets the position of a search occurrence. If the buffer is not already fully
-- scanned, the position may be unknown, and -1 is returned. If 0 is returned,
-- it means that this part of the buffer has already been scanned, and that
-- /@matchStart@/ and /@matchEnd@/ don\'t delimit an occurrence.
-- 
-- /Since: 3.10/
searchContextGetOccurrencePosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Gtk.TextIter.TextIter
    -- ^ /@matchStart@/: the start of the occurrence.
    -> Gtk.TextIter.TextIter
    -- ^ /@matchEnd@/: the end of the occurrence.
    -> m Int32
    -- ^ __Returns:__ the position of the search occurrence. The first occurrence has the
    -- position 1 (not 0). Returns 0 if /@matchStart@/ and /@matchEnd@/ don\'t delimit
    -- an occurrence. Returns -1 if the position is not yet known.
searchContextGetOccurrencePosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> TextIter -> TextIter -> m Int32
searchContextGetOccurrencePosition a
search TextIter
matchStart TextIter
matchEnd = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr TextIter
matchStart' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
matchStart
    Ptr TextIter
matchEnd' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
matchEnd
    Int32
result <- Ptr SearchContext -> Ptr TextIter -> Ptr TextIter -> IO Int32
gtk_source_search_context_get_occurrence_position Ptr SearchContext
search' Ptr TextIter
matchStart' Ptr TextIter
matchEnd'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
matchStart
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
matchEnd
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data SearchContextGetOccurrencePositionMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Gtk.TextIter.TextIter -> m Int32), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextGetOccurrencePositionMethodInfo a signature where
    overloadedMethod = searchContextGetOccurrencePosition

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


#endif

-- method SearchContext::get_occurrences_count
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_get_occurrences_count" gtk_source_search_context_get_occurrences_count :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    IO Int32

-- | Gets the total number of search occurrences. If the buffer is not already
-- fully scanned, the total number of occurrences is unknown, and -1 is
-- returned.
-- 
-- /Since: 3.10/
searchContextGetOccurrencesCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> m Int32
    -- ^ __Returns:__ the total number of search occurrences, or -1 if unknown.
searchContextGetOccurrencesCount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> m Int32
searchContextGetOccurrencesCount a
search = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Int32
result <- Ptr SearchContext -> IO Int32
gtk_source_search_context_get_occurrences_count Ptr SearchContext
search'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data SearchContextGetOccurrencesCountMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextGetOccurrencesCountMethodInfo a signature where
    overloadedMethod = searchContextGetOccurrencesCount

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


#endif

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

foreign import ccall "gtk_source_search_context_get_regex_error" gtk_source_search_context_get_regex_error :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    IO (Ptr GError)

-- | Regular expression patterns must follow certain rules. If
-- t'GI.GtkSource.Objects.SearchSettings.SearchSettings':@/search-text/@ breaks a rule, the error can be retrieved
-- with this function. The error domain is @/G_REGEX_ERROR/@.
-- 
-- Free the return value with 'GI.GLib.Structs.Error.errorFree'.
-- 
-- /Since: 3.10/
searchContextGetRegexError ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> m (Maybe GError)
    -- ^ __Returns:__ the t'GError', or 'P.Nothing' if the pattern is valid.
searchContextGetRegexError :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> m (Maybe GError)
searchContextGetRegexError a
search = IO (Maybe GError) -> m (Maybe GError)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GError) -> m (Maybe GError))
-> IO (Maybe GError) -> m (Maybe GError)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr GError
result <- Ptr SearchContext -> IO (Ptr GError)
gtk_source_search_context_get_regex_error Ptr SearchContext
search'
    Maybe GError
maybeResult <- Ptr GError -> (Ptr GError -> IO GError) -> IO (Maybe GError)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GError
result ((Ptr GError -> IO GError) -> IO (Maybe GError))
-> (Ptr GError -> IO GError) -> IO (Maybe GError)
forall a b. (a -> b) -> a -> b
$ \Ptr GError
result' -> do
        GError
result'' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GError -> GError
GError) Ptr GError
result'
        GError -> IO GError
forall (m :: * -> *) a. Monad m => a -> m a
return GError
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    Maybe GError -> IO (Maybe GError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GError
maybeResult

#if defined(ENABLE_OVERLOADING)
data SearchContextGetRegexErrorMethodInfo
instance (signature ~ (m (Maybe GError)), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextGetRegexErrorMethodInfo a signature where
    overloadedMethod = searchContextGetRegexError

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


#endif

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

foreign import ccall "gtk_source_search_context_get_settings" gtk_source_search_context_get_settings :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    IO (Ptr GtkSource.SearchSettings.SearchSettings)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.10/
searchContextGetSettings ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> m GtkSource.SearchSettings.SearchSettings
    -- ^ __Returns:__ the search settings.
searchContextGetSettings :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> m SearchSettings
searchContextGetSettings a
search = IO SearchSettings -> m SearchSettings
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SearchSettings -> m SearchSettings)
-> IO SearchSettings -> m SearchSettings
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr SearchSettings
result <- Ptr SearchContext -> IO (Ptr SearchSettings)
gtk_source_search_context_get_settings Ptr SearchContext
search'
    Text -> Ptr SearchSettings -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"searchContextGetSettings" Ptr SearchSettings
result
    SearchSettings
result' <- ((ManagedPtr SearchSettings -> SearchSettings)
-> Ptr SearchSettings -> IO SearchSettings
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SearchSettings -> SearchSettings
GtkSource.SearchSettings.SearchSettings) Ptr SearchSettings
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    SearchSettings -> IO SearchSettings
forall (m :: * -> *) a. Monad m => a -> m a
return SearchSettings
result'

#if defined(ENABLE_OVERLOADING)
data SearchContextGetSettingsMethodInfo
instance (signature ~ (m GtkSource.SearchSettings.SearchSettings), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextGetSettingsMethodInfo a signature where
    overloadedMethod = searchContextGetSettings

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


#endif

-- method SearchContext::replace
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start of the match to replace."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the end of the match to replace."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the replacement text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace_length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @replace in bytes, or -1."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gtk_source_search_context_replace" gtk_source_search_context_replace :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    CString ->                              -- replace : TBasicType TUTF8
    Int32 ->                                -- replace_length : TBasicType TInt
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED searchContextReplace ["(Since version 3.22)","Use 'GI.GtkSource.Objects.SearchContext.searchContextReplace2' instead."] #-}
-- | Replaces a search match by another text. If /@matchStart@/ and /@matchEnd@/
-- doesn\'t correspond to a search match, 'P.False' is returned.
-- 
-- For a regular expression replacement, you can check if /@replace@/ is valid by
-- calling 'GI.GLib.Functions.regexCheckReplacement'. The /@replace@/ text can contain
-- backreferences; read the 'GI.GLib.Structs.Regex.regexReplace' documentation for more details.
-- 
-- /Since: 3.10/
searchContextReplace ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Gtk.TextIter.TextIter
    -- ^ /@matchStart@/: the start of the match to replace.
    -> Gtk.TextIter.TextIter
    -- ^ /@matchEnd@/: the end of the match to replace.
    -> T.Text
    -- ^ /@replace@/: the replacement text.
    -> Int32
    -- ^ /@replaceLength@/: the length of /@replace@/ in bytes, or -1.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
searchContextReplace :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> TextIter -> TextIter -> Text -> Int32 -> m ()
searchContextReplace a
search TextIter
matchStart TextIter
matchEnd Text
replace Int32
replaceLength = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr TextIter
matchStart' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
matchStart
    Ptr TextIter
matchEnd' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
matchEnd
    CString
replace' <- Text -> IO CString
textToCString Text
replace
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr SearchContext
-> Ptr TextIter
-> Ptr TextIter
-> CString
-> Int32
-> Ptr (Ptr GError)
-> IO CInt
gtk_source_search_context_replace Ptr SearchContext
search' Ptr TextIter
matchStart' Ptr TextIter
matchEnd' CString
replace' Int32
replaceLength
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
        TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
matchStart
        TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
matchEnd
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
replace'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
replace'
     )

#if defined(ENABLE_OVERLOADING)
data SearchContextReplaceMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Gtk.TextIter.TextIter -> T.Text -> Int32 -> m ()), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextReplaceMethodInfo a signature where
    overloadedMethod = searchContextReplace

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


#endif

-- method SearchContext::replace2
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start of the match to replace."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the end of the match to replace."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the replacement text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace_length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @replace in bytes, or -1."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gtk_source_search_context_replace2" gtk_source_search_context_replace2 :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr Gtk.TextIter.TextIter ->            -- match_start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- match_end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    CString ->                              -- replace : TBasicType TUTF8
    Int32 ->                                -- replace_length : TBasicType TInt
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Replaces a search match by another text. If /@matchStart@/ and /@matchEnd@/
-- doesn\'t correspond to a search match, 'P.False' is returned.
-- 
-- Unlike with 'GI.GtkSource.Objects.SearchContext.searchContextReplace', the /@matchStart@/ and
-- /@matchEnd@/ iters are revalidated to point to the replacement text boundaries.
-- 
-- For a regular expression replacement, you can check if /@replace@/ is valid by
-- calling 'GI.GLib.Functions.regexCheckReplacement'. The /@replace@/ text can contain
-- backreferences; read the 'GI.GLib.Structs.Regex.regexReplace' documentation for more details.
-- 
-- /Since: 3.22/
searchContextReplace2 ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Gtk.TextIter.TextIter
    -- ^ /@matchStart@/: the start of the match to replace.
    -> Gtk.TextIter.TextIter
    -- ^ /@matchEnd@/: the end of the match to replace.
    -> T.Text
    -- ^ /@replace@/: the replacement text.
    -> Int32
    -- ^ /@replaceLength@/: the length of /@replace@/ in bytes, or -1.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
searchContextReplace2 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> TextIter -> TextIter -> Text -> Int32 -> m ()
searchContextReplace2 a
search TextIter
matchStart TextIter
matchEnd Text
replace Int32
replaceLength = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr TextIter
matchStart' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
matchStart
    Ptr TextIter
matchEnd' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
matchEnd
    CString
replace' <- Text -> IO CString
textToCString Text
replace
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr SearchContext
-> Ptr TextIter
-> Ptr TextIter
-> CString
-> Int32
-> Ptr (Ptr GError)
-> IO CInt
gtk_source_search_context_replace2 Ptr SearchContext
search' Ptr TextIter
matchStart' Ptr TextIter
matchEnd' CString
replace' Int32
replaceLength
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
        TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
matchStart
        TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
matchEnd
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
replace'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
replace'
     )

#if defined(ENABLE_OVERLOADING)
data SearchContextReplace2MethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Gtk.TextIter.TextIter -> T.Text -> Int32 -> m ()), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextReplace2MethodInfo a signature where
    overloadedMethod = searchContextReplace2

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


#endif

-- method SearchContext::replace_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the replacement text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace_length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @replace in bytes, or -1."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : True
-- Skip return : False

foreign import ccall "gtk_source_search_context_replace_all" gtk_source_search_context_replace_all :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    CString ->                              -- replace : TBasicType TUTF8
    Int32 ->                                -- replace_length : TBasicType TInt
    Ptr (Ptr GError) ->                     -- error
    IO Word32

-- | Replaces all search matches by another text. It is a synchronous function, so
-- it can block the user interface.
-- 
-- For a regular expression replacement, you can check if /@replace@/ is valid by
-- calling 'GI.GLib.Functions.regexCheckReplacement'. The /@replace@/ text can contain
-- backreferences; read the 'GI.GLib.Structs.Regex.regexReplace' documentation for more details.
-- 
-- /Since: 3.10/
searchContextReplaceAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> T.Text
    -- ^ /@replace@/: the replacement text.
    -> Int32
    -- ^ /@replaceLength@/: the length of /@replace@/ in bytes, or -1.
    -> m Word32
    -- ^ __Returns:__ the number of replaced matches. /(Can throw 'Data.GI.Base.GError.GError')/
searchContextReplaceAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> Text -> Int32 -> m Word32
searchContextReplaceAll a
search Text
replace Int32
replaceLength = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    CString
replace' <- Text -> IO CString
textToCString Text
replace
    IO Word32 -> IO () -> IO Word32
forall a b. IO a -> IO b -> IO a
onException (do
        Word32
result <- (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word32) -> IO Word32)
-> (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ Ptr SearchContext
-> CString -> Int32 -> Ptr (Ptr GError) -> IO Word32
gtk_source_search_context_replace_all Ptr SearchContext
search' CString
replace' Int32
replaceLength
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
replace'
        Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
replace'
     )

#if defined(ENABLE_OVERLOADING)
data SearchContextReplaceAllMethodInfo
instance (signature ~ (T.Text -> Int32 -> m Word32), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextReplaceAllMethodInfo a signature where
    overloadedMethod = searchContextReplaceAll

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


#endif

-- method SearchContext::set_highlight
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "highlight"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the setting." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_set_highlight" gtk_source_search_context_set_highlight :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    CInt ->                                 -- highlight : TBasicType TBoolean
    IO ()

-- | Enables or disables the search occurrences highlighting.
-- 
-- /Since: 3.10/
searchContextSetHighlight ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Bool
    -- ^ /@highlight@/: the setting.
    -> m ()
searchContextSetHighlight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSearchContext a) =>
a -> Bool -> m ()
searchContextSetHighlight a
search Bool
highlight = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    let highlight' :: CInt
highlight' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
highlight
    Ptr SearchContext -> CInt -> IO ()
gtk_source_search_context_set_highlight Ptr SearchContext
search' CInt
highlight'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SearchContextSetHighlightMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSearchContext a) => O.OverloadedMethod SearchContextSetHighlightMethodInfo a signature where
    overloadedMethod = searchContextSetHighlight

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


#endif

-- method SearchContext::set_match_style
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_style"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Style" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceStyle, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_set_match_style" gtk_source_search_context_set_match_style :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr GtkSource.Style.Style ->            -- match_style : TInterface (Name {namespace = "GtkSource", name = "Style"})
    IO ()

-- | Set the style to apply on search matches. If /@matchStyle@/ is 'P.Nothing', default
-- theme\'s scheme \'match-style\' will be used.
-- To enable or disable the search highlighting, use
-- 'GI.GtkSource.Objects.SearchContext.searchContextSetHighlight'.
-- 
-- /Since: 3.16/
searchContextSetMatchStyle ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a, GtkSource.Style.IsStyle b) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Maybe (b)
    -- ^ /@matchStyle@/: a t'GI.GtkSource.Objects.Style.Style', or 'P.Nothing'.
    -> m ()
searchContextSetMatchStyle :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSearchContext a, IsStyle b) =>
a -> Maybe b -> m ()
searchContextSetMatchStyle a
search Maybe b
matchStyle = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr Style
maybeMatchStyle <- case Maybe b
matchStyle of
        Maybe b
Nothing -> Ptr Style -> IO (Ptr Style)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Style
forall a. Ptr a
nullPtr
        Just b
jMatchStyle -> do
            Ptr Style
jMatchStyle' <- b -> IO (Ptr Style)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMatchStyle
            Ptr Style -> IO (Ptr Style)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Style
jMatchStyle'
    Ptr SearchContext -> Ptr Style -> IO ()
gtk_source_search_context_set_match_style Ptr SearchContext
search' Ptr Style
maybeMatchStyle
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
matchStyle b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SearchContextSetMatchStyleMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSearchContext a, GtkSource.Style.IsStyle b) => O.OverloadedMethod SearchContextSetMatchStyleMethodInfo a signature where
    overloadedMethod = searchContextSetMatchStyle

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


#endif

-- method SearchContext::set_settings
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "search"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchContext."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new #GtkSourceSearchSettings, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_context_set_settings" gtk_source_search_context_set_settings :: 
    Ptr SearchContext ->                    -- search : TInterface (Name {namespace = "GtkSource", name = "SearchContext"})
    Ptr GtkSource.SearchSettings.SearchSettings -> -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    IO ()

{-# DEPRECATED searchContextSetSettings ["(Since version 3.24)","The t'GI.GtkSource.Objects.SearchContext.SearchContext':@/settings/@ property will become a","construct-only property in a future version. Create a new","t'GI.GtkSource.Objects.SearchContext.SearchContext' instead, or change the t'GI.GtkSource.Objects.SearchSettings.SearchSettings'","properties. When the t'GI.GtkSource.Objects.SearchContext.SearchContext':@/settings/@ property will become","construct-only, it will be possible to simplify some code that needed to","listen to the notify[settings](#g:signal:settings) signal."] #-}
-- | Associate a t'GI.GtkSource.Objects.SearchSettings.SearchSettings' with the search context. If /@settings@/ is
-- 'P.Nothing', a new one will be created.
-- 
-- The search context holds a reference to /@settings@/.
-- 
-- /Since: 3.10/
searchContextSetSettings ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchContext a, GtkSource.SearchSettings.IsSearchSettings b) =>
    a
    -- ^ /@search@/: a t'GI.GtkSource.Objects.SearchContext.SearchContext'.
    -> Maybe (b)
    -- ^ /@settings@/: the new t'GI.GtkSource.Objects.SearchSettings.SearchSettings', or 'P.Nothing'.
    -> m ()
searchContextSetSettings :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSearchContext a, IsSearchSettings b) =>
a -> Maybe b -> m ()
searchContextSetSettings a
search Maybe b
settings = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchContext
search' <- a -> IO (Ptr SearchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
search
    Ptr SearchSettings
maybeSettings <- case Maybe b
settings of
        Maybe b
Nothing -> Ptr SearchSettings -> IO (Ptr SearchSettings)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SearchSettings
forall a. Ptr a
nullPtr
        Just b
jSettings -> do
            Ptr SearchSettings
jSettings' <- b -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSettings
            Ptr SearchSettings -> IO (Ptr SearchSettings)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SearchSettings
jSettings'
    Ptr SearchContext -> Ptr SearchSettings -> IO ()
gtk_source_search_context_set_settings Ptr SearchContext
search' Ptr SearchSettings
maybeSettings
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
search
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
settings b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SearchContextSetSettingsMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSearchContext a, GtkSource.SearchSettings.IsSearchSettings b) => O.OverloadedMethod SearchContextSetSettingsMethodInfo a signature where
    overloadedMethod = searchContextSetSettings

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


#endif