{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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.Region
    ( 

-- * Exported types
    Region(..)                              ,
    IsRegion                                ,
    toRegion                                ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveRegionMethod                     ,
#endif


-- ** addRegion #method:addRegion#

#if defined(ENABLE_OVERLOADING)
    RegionAddRegionMethodInfo               ,
#endif
    regionAddRegion                         ,


-- ** addSubregion #method:addSubregion#

#if defined(ENABLE_OVERLOADING)
    RegionAddSubregionMethodInfo            ,
#endif
    regionAddSubregion                      ,


-- ** getBounds #method:getBounds#

#if defined(ENABLE_OVERLOADING)
    RegionGetBoundsMethodInfo               ,
#endif
    regionGetBounds                         ,


-- ** getBuffer #method:getBuffer#

#if defined(ENABLE_OVERLOADING)
    RegionGetBufferMethodInfo               ,
#endif
    regionGetBuffer                         ,


-- ** getStartRegionIter #method:getStartRegionIter#

#if defined(ENABLE_OVERLOADING)
    RegionGetStartRegionIterMethodInfo      ,
#endif
    regionGetStartRegionIter                ,


-- ** intersectRegion #method:intersectRegion#

#if defined(ENABLE_OVERLOADING)
    RegionIntersectRegionMethodInfo         ,
#endif
    regionIntersectRegion                   ,


-- ** intersectSubregion #method:intersectSubregion#

#if defined(ENABLE_OVERLOADING)
    RegionIntersectSubregionMethodInfo      ,
#endif
    regionIntersectSubregion                ,


-- ** isEmpty #method:isEmpty#

#if defined(ENABLE_OVERLOADING)
    RegionIsEmptyMethodInfo                 ,
#endif
    regionIsEmpty                           ,


-- ** new #method:new#

    regionNew                               ,


-- ** subtractRegion #method:subtractRegion#

#if defined(ENABLE_OVERLOADING)
    RegionSubtractRegionMethodInfo          ,
#endif
    regionSubtractRegion                    ,


-- ** subtractSubregion #method:subtractSubregion#

#if defined(ENABLE_OVERLOADING)
    RegionSubtractSubregionMethodInfo       ,
#endif
    regionSubtractSubregion                 ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    RegionToStringMethodInfo                ,
#endif
    regionToString                          ,




 -- * Properties
-- ** buffer #attr:buffer#
-- | The t'GI.Gtk.Objects.TextBuffer.TextBuffer'. The t'GI.GtkSource.Objects.Region.Region' has a weak reference to the
-- buffer.
-- 
-- /Since: 3.22/

#if defined(ENABLE_OVERLOADING)
    RegionBufferPropertyInfo                ,
#endif
    constructRegionBuffer                   ,
    getRegionBuffer                         ,
#if defined(ENABLE_OVERLOADING)
    regionBuffer                            ,
#endif




    ) 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.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.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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.TextBuffer as Gtk.TextBuffer
import qualified GI.Gtk.Structs.TextIter as Gtk.TextIter
import {-# SOURCE #-} qualified GI.GtkSource.Structs.RegionIter as GtkSource.RegionIter

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

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

foreign import ccall "gtk_source_region_get_type"
    c_gtk_source_region_get_type :: IO B.Types.GType

instance B.Types.TypedObject Region where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_region_get_type

instance B.Types.GObject Region

-- | Convert 'Region' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Region where
    toGValue :: Region -> IO GValue
toGValue Region
o = do
        GType
gtype <- IO GType
c_gtk_source_region_get_type
        Region -> (Ptr Region -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Region
o (GType -> (GValue -> Ptr Region -> IO ()) -> Ptr Region -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Region -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Region
fromGValue GValue
gv = do
        Ptr Region
ptr <- GValue -> IO (Ptr Region)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Region)
        (ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Region -> Region
Region Ptr Region
ptr
        
    

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveRegionMethod (t :: Symbol) (o :: *) :: * where
    ResolveRegionMethod "addRegion" o = RegionAddRegionMethodInfo
    ResolveRegionMethod "addSubregion" o = RegionAddSubregionMethodInfo
    ResolveRegionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRegionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRegionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRegionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRegionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRegionMethod "intersectRegion" o = RegionIntersectRegionMethodInfo
    ResolveRegionMethod "intersectSubregion" o = RegionIntersectSubregionMethodInfo
    ResolveRegionMethod "isEmpty" o = RegionIsEmptyMethodInfo
    ResolveRegionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRegionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRegionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRegionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRegionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRegionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRegionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRegionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRegionMethod "subtractRegion" o = RegionSubtractRegionMethodInfo
    ResolveRegionMethod "subtractSubregion" o = RegionSubtractSubregionMethodInfo
    ResolveRegionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRegionMethod "toString" o = RegionToStringMethodInfo
    ResolveRegionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRegionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRegionMethod "getBounds" o = RegionGetBoundsMethodInfo
    ResolveRegionMethod "getBuffer" o = RegionGetBufferMethodInfo
    ResolveRegionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRegionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRegionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRegionMethod "getStartRegionIter" o = RegionGetStartRegionIterMethodInfo
    ResolveRegionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRegionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRegionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRegionMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "buffer"
   -- Type: TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,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' region #buffer
-- @
getRegionBuffer :: (MonadIO m, IsRegion o) => o -> m (Maybe Gtk.TextBuffer.TextBuffer)
getRegionBuffer :: o -> m (Maybe TextBuffer)
getRegionBuffer o
obj = IO (Maybe TextBuffer) -> m (Maybe TextBuffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TextBuffer) -> m (Maybe TextBuffer))
-> IO (Maybe TextBuffer) -> m (Maybe TextBuffer)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr TextBuffer -> TextBuffer)
-> IO (Maybe TextBuffer)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"buffer" ManagedPtr TextBuffer -> TextBuffer
Gtk.TextBuffer.TextBuffer

-- | 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`.
constructRegionBuffer :: (IsRegion o, MIO.MonadIO m, Gtk.TextBuffer.IsTextBuffer a) => a -> m (GValueConstruct o)
constructRegionBuffer :: a -> m (GValueConstruct o)
constructRegionBuffer 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
$ 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 RegionBufferPropertyInfo
instance AttrInfo RegionBufferPropertyInfo where
    type AttrAllowedOps RegionBufferPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint RegionBufferPropertyInfo = IsRegion
    type AttrSetTypeConstraint RegionBufferPropertyInfo = Gtk.TextBuffer.IsTextBuffer
    type AttrTransferTypeConstraint RegionBufferPropertyInfo = Gtk.TextBuffer.IsTextBuffer
    type AttrTransferType RegionBufferPropertyInfo = Gtk.TextBuffer.TextBuffer
    type AttrGetType RegionBufferPropertyInfo = (Maybe Gtk.TextBuffer.TextBuffer)
    type AttrLabel RegionBufferPropertyInfo = "buffer"
    type AttrOrigin RegionBufferPropertyInfo = Region
    attrGet = getRegionBuffer
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.TextBuffer.TextBuffer v
    attrConstruct = constructRegionBuffer
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Region
type instance O.AttributeList Region = RegionAttributeList
type RegionAttributeList = ('[ '("buffer", RegionBufferPropertyInfo)] :: [(Symbol, *)])
#endif

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

#endif

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

#endif

-- method Region::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GtkSource" , name = "Region" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_region_new" gtk_source_region_new :: 
    Ptr Gtk.TextBuffer.TextBuffer ->        -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    IO (Ptr Region)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.22/
regionNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.TextBuffer.IsTextBuffer a) =>
    a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'.
    -> m Region
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.Region.Region' object for /@buffer@/.
regionNew :: a -> m Region
regionNew a
buffer = IO Region -> m Region
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Region -> m Region) -> IO Region -> m Region
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr Region
result <- Ptr TextBuffer -> IO (Ptr Region)
gtk_source_region_new Ptr TextBuffer
buffer'
    Text -> Ptr Region -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"regionNew" Ptr Region
result
    Region
result' <- ((ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Region -> Region
Region) Ptr Region
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    Region -> IO Region
forall (m :: * -> *) a. Monad m => a -> m a
return Region
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Region::add_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceRegion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "region_to_add"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GtkSourceRegion to add to @region, 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_region_add_region" gtk_source_region_add_region :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "GtkSource", name = "Region"})
    Ptr Region ->                           -- region_to_add : TInterface (Name {namespace = "GtkSource", name = "Region"})
    IO ()

-- | Adds /@regionToAdd@/ to /@region@/. /@regionToAdd@/ is not modified.
-- 
-- /Since: 3.22/
regionAddRegion ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
    a
    -- ^ /@region@/: a t'GI.GtkSource.Objects.Region.Region'.
    -> Maybe (b)
    -- ^ /@regionToAdd@/: the t'GI.GtkSource.Objects.Region.Region' to add to /@region@/, or 'P.Nothing'.
    -> m ()
regionAddRegion :: a -> Maybe b -> m ()
regionAddRegion a
region Maybe b
regionToAdd = 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 Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Ptr Region
maybeRegionToAdd <- case Maybe b
regionToAdd of
        Maybe b
Nothing -> Ptr Region -> IO (Ptr Region)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Region
forall a. Ptr a
nullPtr
        Just b
jRegionToAdd -> do
            Ptr Region
jRegionToAdd' <- b -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jRegionToAdd
            Ptr Region -> IO (Ptr Region)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Region
jRegionToAdd'
    Ptr Region -> Ptr Region -> IO ()
gtk_source_region_add_region Ptr Region
region' Ptr Region
maybeRegionToAdd
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
regionToAdd b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegionAddRegionMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsRegion a, IsRegion b) => O.MethodInfo RegionAddRegionMethodInfo a signature where
    overloadedMethod = regionAddRegion

#endif

-- method Region::add_subregion
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceRegion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start of the subregion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the end of the subregion."
--                 , 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_region_add_subregion" gtk_source_region_add_subregion :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "GtkSource", name = "Region"})
    Ptr Gtk.TextIter.TextIter ->            -- _start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- _end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO ()

-- | Adds the subregion delimited by /@start_@/ and /@end_@/ to /@region@/.
-- 
-- /Since: 3.22/
regionAddSubregion ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@region@/: a t'GI.GtkSource.Objects.Region.Region'.
    -> Gtk.TextIter.TextIter
    -- ^ /@start_@/: the start of the subregion.
    -> Gtk.TextIter.TextIter
    -- ^ /@end_@/: the end of the subregion.
    -> m ()
regionAddSubregion :: a -> TextIter -> TextIter -> m ()
regionAddSubregion a
region TextIter
_start TextIter
_end = 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 Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Ptr TextIter
_start' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
_start
    Ptr TextIter
_end' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
_end
    Ptr Region -> Ptr TextIter -> Ptr TextIter -> IO ()
gtk_source_region_add_subregion Ptr Region
region' Ptr TextIter
_start' Ptr TextIter
_end'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
_start
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
_end
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegionAddSubregionMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Gtk.TextIter.TextIter -> m ()), MonadIO m, IsRegion a) => O.MethodInfo RegionAddSubregionMethodInfo a signature where
    overloadedMethod = regionAddSubregion

#endif

-- method Region::get_bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceRegion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "iterator to initialize with the start of @region,\n  or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "iterator to initialize with the end of @region,\n  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_region_get_bounds" gtk_source_region_get_bounds :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "GtkSource", name = "Region"})
    Ptr Gtk.TextIter.TextIter ->            -- start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO CInt

-- | Gets the /@start@/ and /@end@/ bounds of the /@region@/.
-- 
-- /Since: 3.22/
regionGetBounds ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@region@/: a t'GI.GtkSource.Objects.Region.Region'.
    -> m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))
    -- ^ __Returns:__ 'P.True' if /@start@/ and /@end@/ have been set successfully (if non-'P.Nothing'),
    --   or 'P.False' if the /@region@/ is empty.
regionGetBounds :: a -> m (Bool, TextIter, TextIter)
regionGetBounds a
region = 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 Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Ptr TextIter
start <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    Ptr TextIter
end <- Int -> IO (Ptr TextIter)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
80 :: IO (Ptr Gtk.TextIter.TextIter)
    CInt
result <- Ptr Region -> Ptr TextIter -> Ptr TextIter -> IO CInt
gtk_source_region_get_bounds Ptr Region
region' Ptr TextIter
start Ptr TextIter
end
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TextIter
start' <- ((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
start
    TextIter
end' <- ((ManagedPtr TextIter -> TextIter) -> Ptr TextIter -> IO TextIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TextIter -> TextIter
Gtk.TextIter.TextIter) Ptr TextIter
end
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    (Bool, TextIter, TextIter) -> IO (Bool, TextIter, TextIter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', TextIter
start', TextIter
end')

#if defined(ENABLE_OVERLOADING)
data RegionGetBoundsMethodInfo
instance (signature ~ (m ((Bool, Gtk.TextIter.TextIter, Gtk.TextIter.TextIter))), MonadIO m, IsRegion a) => O.MethodInfo RegionGetBoundsMethodInfo a signature where
    overloadedMethod = regionGetBounds

#endif

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

foreign import ccall "gtk_source_region_get_buffer" gtk_source_region_get_buffer :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "GtkSource", name = "Region"})
    IO (Ptr Gtk.TextBuffer.TextBuffer)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.22/
regionGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@region@/: a t'GI.GtkSource.Objects.Region.Region'.
    -> m (Maybe Gtk.TextBuffer.TextBuffer)
    -- ^ __Returns:__ the t'GI.Gtk.Objects.TextBuffer.TextBuffer'.
regionGetBuffer :: a -> m (Maybe TextBuffer)
regionGetBuffer a
region = IO (Maybe TextBuffer) -> m (Maybe TextBuffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TextBuffer) -> m (Maybe TextBuffer))
-> IO (Maybe TextBuffer) -> m (Maybe TextBuffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Ptr TextBuffer
result <- Ptr Region -> IO (Ptr TextBuffer)
gtk_source_region_get_buffer Ptr Region
region'
    Maybe TextBuffer
maybeResult <- Ptr TextBuffer
-> (Ptr TextBuffer -> IO TextBuffer) -> IO (Maybe TextBuffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TextBuffer
result ((Ptr TextBuffer -> IO TextBuffer) -> IO (Maybe TextBuffer))
-> (Ptr TextBuffer -> IO TextBuffer) -> IO (Maybe TextBuffer)
forall a b. (a -> b) -> a -> b
$ \Ptr TextBuffer
result' -> do
        TextBuffer
result'' <- ((ManagedPtr TextBuffer -> TextBuffer)
-> Ptr TextBuffer -> IO TextBuffer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TextBuffer -> TextBuffer
Gtk.TextBuffer.TextBuffer) Ptr TextBuffer
result'
        TextBuffer -> IO TextBuffer
forall (m :: * -> *) a. Monad m => a -> m a
return TextBuffer
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    Maybe TextBuffer -> IO (Maybe TextBuffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TextBuffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data RegionGetBufferMethodInfo
instance (signature ~ (m (Maybe Gtk.TextBuffer.TextBuffer)), MonadIO m, IsRegion a) => O.MethodInfo RegionGetBufferMethodInfo a signature where
    overloadedMethod = regionGetBuffer

#endif

-- method Region::get_start_region_iter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceRegion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "RegionIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "iterator to initialize to the first subregion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_region_get_start_region_iter" gtk_source_region_get_start_region_iter :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "GtkSource", name = "Region"})
    Ptr GtkSource.RegionIter.RegionIter ->  -- iter : TInterface (Name {namespace = "GtkSource", name = "RegionIter"})
    IO ()

-- | Initializes a t'GI.GtkSource.Structs.RegionIter.RegionIter' to the first subregion of /@region@/. If
-- /@region@/ is empty, /@iter@/ will be initialized to the end iterator.
-- 
-- /Since: 3.22/
regionGetStartRegionIter ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@region@/: a t'GI.GtkSource.Objects.Region.Region'.
    -> m (GtkSource.RegionIter.RegionIter)
regionGetStartRegionIter :: a -> m RegionIter
regionGetStartRegionIter a
region = IO RegionIter -> m RegionIter
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RegionIter -> m RegionIter) -> IO RegionIter -> m RegionIter
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Ptr RegionIter
iter <- Int -> IO (Ptr RegionIter)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GtkSource.RegionIter.RegionIter)
    Ptr Region -> Ptr RegionIter -> IO ()
gtk_source_region_get_start_region_iter Ptr Region
region' Ptr RegionIter
iter
    RegionIter
iter' <- ((ManagedPtr RegionIter -> RegionIter)
-> Ptr RegionIter -> IO RegionIter
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr RegionIter -> RegionIter
GtkSource.RegionIter.RegionIter) Ptr RegionIter
iter
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    RegionIter -> IO RegionIter
forall (m :: * -> *) a. Monad m => a -> m a
return RegionIter
iter'

#if defined(ENABLE_OVERLOADING)
data RegionGetStartRegionIterMethodInfo
instance (signature ~ (m (GtkSource.RegionIter.RegionIter)), MonadIO m, IsRegion a) => O.MethodInfo RegionGetStartRegionIterMethodInfo a signature where
    overloadedMethod = regionGetStartRegionIter

#endif

-- method Region::intersect_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region1"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceRegion, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "region2"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceRegion, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GtkSource" , name = "Region" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_region_intersect_region" gtk_source_region_intersect_region :: 
    Ptr Region ->                           -- region1 : TInterface (Name {namespace = "GtkSource", name = "Region"})
    Ptr Region ->                           -- region2 : TInterface (Name {namespace = "GtkSource", name = "Region"})
    IO (Ptr Region)

-- | Returns the intersection between /@region1@/ and /@region2@/. /@region1@/ and
-- /@region2@/ are not modified.
-- 
-- /Since: 3.22/
regionIntersectRegion ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
    a
    -- ^ /@region1@/: a t'GI.GtkSource.Objects.Region.Region', or 'P.Nothing'.
    -> Maybe (b)
    -- ^ /@region2@/: a t'GI.GtkSource.Objects.Region.Region', or 'P.Nothing'.
    -> m (Maybe Region)
    -- ^ __Returns:__ the intersection as a t'GI.GtkSource.Objects.Region.Region'
    --   object.
regionIntersectRegion :: a -> Maybe b -> m (Maybe Region)
regionIntersectRegion a
region1 Maybe b
region2 = IO (Maybe Region) -> m (Maybe Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Region) -> m (Maybe Region))
-> IO (Maybe Region) -> m (Maybe Region)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
region1' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region1
    Ptr Region
maybeRegion2 <- case Maybe b
region2 of
        Maybe b
Nothing -> Ptr Region -> IO (Ptr Region)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Region
forall a. Ptr a
nullPtr
        Just b
jRegion2 -> do
            Ptr Region
jRegion2' <- b -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jRegion2
            Ptr Region -> IO (Ptr Region)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Region
jRegion2'
    Ptr Region
result <- Ptr Region -> Ptr Region -> IO (Ptr Region)
gtk_source_region_intersect_region Ptr Region
region1' Ptr Region
maybeRegion2
    Maybe Region
maybeResult <- Ptr Region -> (Ptr Region -> IO Region) -> IO (Maybe Region)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Region
result ((Ptr Region -> IO Region) -> IO (Maybe Region))
-> (Ptr Region -> IO Region) -> IO (Maybe Region)
forall a b. (a -> b) -> a -> b
$ \Ptr Region
result' -> do
        Region
result'' <- ((ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Region -> Region
Region) Ptr Region
result'
        Region -> IO Region
forall (m :: * -> *) a. Monad m => a -> m a
return Region
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region1
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
region2 b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Region -> IO (Maybe Region)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Region
maybeResult

#if defined(ENABLE_OVERLOADING)
data RegionIntersectRegionMethodInfo
instance (signature ~ (Maybe (b) -> m (Maybe Region)), MonadIO m, IsRegion a, IsRegion b) => O.MethodInfo RegionIntersectRegionMethodInfo a signature where
    overloadedMethod = regionIntersectRegion

#endif

-- method Region::intersect_subregion
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceRegion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start of the subregion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the end of the subregion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GtkSource" , name = "Region" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_region_intersect_subregion" gtk_source_region_intersect_subregion :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "GtkSource", name = "Region"})
    Ptr Gtk.TextIter.TextIter ->            -- _start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- _end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO (Ptr Region)

-- | Returns the intersection between /@region@/ and the subregion delimited by
-- /@start_@/ and /@end_@/. /@region@/ is not modified.
-- 
-- /Since: 3.22/
regionIntersectSubregion ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@region@/: a t'GI.GtkSource.Objects.Region.Region'.
    -> Gtk.TextIter.TextIter
    -- ^ /@start_@/: the start of the subregion.
    -> Gtk.TextIter.TextIter
    -- ^ /@end_@/: the end of the subregion.
    -> m (Maybe Region)
    -- ^ __Returns:__ the intersection as a new
    --   t'GI.GtkSource.Objects.Region.Region'.
regionIntersectSubregion :: a -> TextIter -> TextIter -> m (Maybe Region)
regionIntersectSubregion a
region TextIter
_start TextIter
_end = IO (Maybe Region) -> m (Maybe Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Region) -> m (Maybe Region))
-> IO (Maybe Region) -> m (Maybe Region)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Ptr TextIter
_start' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
_start
    Ptr TextIter
_end' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
_end
    Ptr Region
result <- Ptr Region -> Ptr TextIter -> Ptr TextIter -> IO (Ptr Region)
gtk_source_region_intersect_subregion Ptr Region
region' Ptr TextIter
_start' Ptr TextIter
_end'
    Maybe Region
maybeResult <- Ptr Region -> (Ptr Region -> IO Region) -> IO (Maybe Region)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Region
result ((Ptr Region -> IO Region) -> IO (Maybe Region))
-> (Ptr Region -> IO Region) -> IO (Maybe Region)
forall a b. (a -> b) -> a -> b
$ \Ptr Region
result' -> do
        Region
result'' <- ((ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Region -> Region
Region) Ptr Region
result'
        Region -> IO Region
forall (m :: * -> *) a. Monad m => a -> m a
return Region
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
_start
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
_end
    Maybe Region -> IO (Maybe Region)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Region
maybeResult

#if defined(ENABLE_OVERLOADING)
data RegionIntersectSubregionMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Gtk.TextIter.TextIter -> m (Maybe Region)), MonadIO m, IsRegion a) => O.MethodInfo RegionIntersectSubregionMethodInfo a signature where
    overloadedMethod = regionIntersectSubregion

#endif

-- method Region::is_empty
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceRegion, or %NULL."
--                 , 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_region_is_empty" gtk_source_region_is_empty :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "GtkSource", name = "Region"})
    IO CInt

-- | Returns whether the /@region@/ is empty. A 'P.Nothing' /@region@/ is considered empty.
-- 
-- /Since: 3.22/
regionIsEmpty ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@region@/: a t'GI.GtkSource.Objects.Region.Region', or 'P.Nothing'.
    -> m Bool
    -- ^ __Returns:__ whether the /@region@/ is empty.
regionIsEmpty :: a -> m Bool
regionIsEmpty a
region = 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 Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    CInt
result <- Ptr Region -> IO CInt
gtk_source_region_is_empty Ptr Region
region'
    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
region
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RegionIsEmptyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRegion a) => O.MethodInfo RegionIsEmptyMethodInfo a signature where
    overloadedMethod = regionIsEmpty

#endif

-- method Region::subtract_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceRegion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "region_to_subtract"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GtkSourceRegion to subtract from\n  @region, 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_region_subtract_region" gtk_source_region_subtract_region :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "GtkSource", name = "Region"})
    Ptr Region ->                           -- region_to_subtract : TInterface (Name {namespace = "GtkSource", name = "Region"})
    IO ()

-- | Subtracts /@regionToSubtract@/ from /@region@/. /@regionToSubtract@/ is not
-- modified.
-- 
-- /Since: 3.22/
regionSubtractRegion ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
    a
    -- ^ /@region@/: a t'GI.GtkSource.Objects.Region.Region'.
    -> Maybe (b)
    -- ^ /@regionToSubtract@/: the t'GI.GtkSource.Objects.Region.Region' to subtract from
    --   /@region@/, or 'P.Nothing'.
    -> m ()
regionSubtractRegion :: a -> Maybe b -> m ()
regionSubtractRegion a
region Maybe b
regionToSubtract = 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 Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Ptr Region
maybeRegionToSubtract <- case Maybe b
regionToSubtract of
        Maybe b
Nothing -> Ptr Region -> IO (Ptr Region)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Region
forall a. Ptr a
nullPtr
        Just b
jRegionToSubtract -> do
            Ptr Region
jRegionToSubtract' <- b -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jRegionToSubtract
            Ptr Region -> IO (Ptr Region)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Region
jRegionToSubtract'
    Ptr Region -> Ptr Region -> IO ()
gtk_source_region_subtract_region Ptr Region
region' Ptr Region
maybeRegionToSubtract
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
regionToSubtract b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegionSubtractRegionMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsRegion a, IsRegion b) => O.MethodInfo RegionSubtractRegionMethodInfo a signature where
    overloadedMethod = regionSubtractRegion

#endif

-- method Region::subtract_subregion
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceRegion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "_start"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start of the subregion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "_end"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the end of the subregion."
--                 , 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_region_subtract_subregion" gtk_source_region_subtract_subregion :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "GtkSource", name = "Region"})
    Ptr Gtk.TextIter.TextIter ->            -- _start : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    Ptr Gtk.TextIter.TextIter ->            -- _end : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    IO ()

-- | Subtracts the subregion delimited by /@start_@/ and /@end_@/ from /@region@/.
-- 
-- /Since: 3.22/
regionSubtractSubregion ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@region@/: a t'GI.GtkSource.Objects.Region.Region'.
    -> Gtk.TextIter.TextIter
    -- ^ /@start_@/: the start of the subregion.
    -> Gtk.TextIter.TextIter
    -- ^ /@end_@/: the end of the subregion.
    -> m ()
regionSubtractSubregion :: a -> TextIter -> TextIter -> m ()
regionSubtractSubregion a
region TextIter
_start TextIter
_end = 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 Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Ptr TextIter
_start' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
_start
    Ptr TextIter
_end' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
_end
    Ptr Region -> Ptr TextIter -> Ptr TextIter -> IO ()
gtk_source_region_subtract_subregion Ptr Region
region' Ptr TextIter
_start' Ptr TextIter
_end'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
_start
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
_end
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegionSubtractSubregionMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Gtk.TextIter.TextIter -> m ()), MonadIO m, IsRegion a) => O.MethodInfo RegionSubtractSubregionMethodInfo a signature where
    overloadedMethod = regionSubtractSubregion

#endif

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

foreign import ccall "gtk_source_region_to_string" gtk_source_region_to_string :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "GtkSource", name = "Region"})
    IO CString

-- | Gets a string represention of /@region@/, for debugging purposes.
-- 
-- The returned string contains the character offsets of the subregions. It
-- doesn\'t include a newline character at the end of the string.
-- 
-- /Since: 3.22/
regionToString ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@region@/: a t'GI.GtkSource.Objects.Region.Region'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string represention of /@region@/. Free
    --   with 'GI.GLib.Functions.free' when no longer needed.
regionToString :: a -> m (Maybe Text)
regionToString a
region = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    CString
result <- Ptr Region -> IO CString
gtk_source_region_to_string Ptr Region
region'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data RegionToStringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsRegion a) => O.MethodInfo RegionToStringMethodInfo a signature where
    overloadedMethod = regionToString

#endif