{-# 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.SpaceDrawer
    ( 

-- * Exported types
    SpaceDrawer(..)                         ,
    IsSpaceDrawer                           ,
    toSpaceDrawer                           ,
    noSpaceDrawer                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveSpaceDrawerMethod                ,
#endif


-- ** bindMatrixSetting #method:bindMatrixSetting#

#if defined(ENABLE_OVERLOADING)
    SpaceDrawerBindMatrixSettingMethodInfo  ,
#endif
    spaceDrawerBindMatrixSetting            ,


-- ** getEnableMatrix #method:getEnableMatrix#

#if defined(ENABLE_OVERLOADING)
    SpaceDrawerGetEnableMatrixMethodInfo    ,
#endif
    spaceDrawerGetEnableMatrix              ,


-- ** getMatrix #method:getMatrix#

#if defined(ENABLE_OVERLOADING)
    SpaceDrawerGetMatrixMethodInfo          ,
#endif
    spaceDrawerGetMatrix                    ,


-- ** getTypesForLocations #method:getTypesForLocations#

#if defined(ENABLE_OVERLOADING)
    SpaceDrawerGetTypesForLocationsMethodInfo,
#endif
    spaceDrawerGetTypesForLocations         ,


-- ** new #method:new#

    spaceDrawerNew                          ,


-- ** setEnableMatrix #method:setEnableMatrix#

#if defined(ENABLE_OVERLOADING)
    SpaceDrawerSetEnableMatrixMethodInfo    ,
#endif
    spaceDrawerSetEnableMatrix              ,


-- ** setMatrix #method:setMatrix#

#if defined(ENABLE_OVERLOADING)
    SpaceDrawerSetMatrixMethodInfo          ,
#endif
    spaceDrawerSetMatrix                    ,


-- ** setTypesForLocations #method:setTypesForLocations#

#if defined(ENABLE_OVERLOADING)
    SpaceDrawerSetTypesForLocationsMethodInfo,
#endif
    spaceDrawerSetTypesForLocations         ,




 -- * Properties
-- ** enableMatrix #attr:enableMatrix#
-- | Whether the t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ property is enabled.
-- 
-- /Since: 3.24/

#if defined(ENABLE_OVERLOADING)
    SpaceDrawerEnableMatrixPropertyInfo     ,
#endif
    constructSpaceDrawerEnableMatrix        ,
    getSpaceDrawerEnableMatrix              ,
    setSpaceDrawerEnableMatrix              ,
#if defined(ENABLE_OVERLOADING)
    spaceDrawerEnableMatrix                 ,
#endif


-- ** matrix #attr:matrix#
-- | The :matrix property is a t'GVariant' property to specify where and
-- what kind of white spaces to draw.
-- 
-- The t'GVariant' is of type @\"au\"@, an array of unsigned integers. Each
-- integer is a combination of t'GI.GtkSource.Flags.SpaceTypeFlags'. There is one
-- integer for each t'GI.GtkSource.Flags.SpaceLocationFlags', in the same order as
-- they are defined in the enum ('GI.GtkSource.Flags.SpaceLocationFlagsNone' and
-- 'GI.GtkSource.Flags.SpaceLocationFlagsAll' are not taken into account).
-- 
-- If the array is shorter than the number of locations, then the value
-- for the missing locations will be 'GI.GtkSource.Flags.SpaceTypeFlagsNone'.
-- 
-- By default, 'GI.GtkSource.Flags.SpaceTypeFlagsAll' is set for all locations.
-- 
-- /Since: 3.24/

#if defined(ENABLE_OVERLOADING)
    SpaceDrawerMatrixPropertyInfo           ,
#endif
    clearSpaceDrawerMatrix                  ,
    constructSpaceDrawerMatrix              ,
    getSpaceDrawerMatrix                    ,
    setSpaceDrawerMatrix                    ,
#if defined(ENABLE_OVERLOADING)
    spaceDrawerMatrix                       ,
#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.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 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.Gio.Flags as Gio.Flags
import qualified GI.Gio.Objects.Settings as Gio.Settings
import {-# SOURCE #-} qualified GI.GtkSource.Flags as GtkSource.Flags

-- | Memory-managed wrapper type.
newtype SpaceDrawer = SpaceDrawer (ManagedPtr SpaceDrawer)
    deriving (SpaceDrawer -> SpaceDrawer -> Bool
(SpaceDrawer -> SpaceDrawer -> Bool)
-> (SpaceDrawer -> SpaceDrawer -> Bool) -> Eq SpaceDrawer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpaceDrawer -> SpaceDrawer -> Bool
$c/= :: SpaceDrawer -> SpaceDrawer -> Bool
== :: SpaceDrawer -> SpaceDrawer -> Bool
$c== :: SpaceDrawer -> SpaceDrawer -> Bool
Eq)
foreign import ccall "gtk_source_space_drawer_get_type"
    c_gtk_source_space_drawer_get_type :: IO GType

instance GObject SpaceDrawer where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_source_space_drawer_get_type
    

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

-- | Type class for types which can be safely cast to `SpaceDrawer`, for instance with `toSpaceDrawer`.
class (GObject o, O.IsDescendantOf SpaceDrawer o) => IsSpaceDrawer o
instance (GObject o, O.IsDescendantOf SpaceDrawer o) => IsSpaceDrawer o

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `SpaceDrawer`.
noSpaceDrawer :: Maybe SpaceDrawer
noSpaceDrawer :: Maybe SpaceDrawer
noSpaceDrawer = Maybe SpaceDrawer
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveSpaceDrawerMethod (t :: Symbol) (o :: *) :: * where
    ResolveSpaceDrawerMethod "bindMatrixSetting" o = SpaceDrawerBindMatrixSettingMethodInfo
    ResolveSpaceDrawerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSpaceDrawerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSpaceDrawerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSpaceDrawerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSpaceDrawerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSpaceDrawerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSpaceDrawerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSpaceDrawerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSpaceDrawerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSpaceDrawerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSpaceDrawerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSpaceDrawerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSpaceDrawerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSpaceDrawerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSpaceDrawerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSpaceDrawerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSpaceDrawerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSpaceDrawerMethod "getEnableMatrix" o = SpaceDrawerGetEnableMatrixMethodInfo
    ResolveSpaceDrawerMethod "getMatrix" o = SpaceDrawerGetMatrixMethodInfo
    ResolveSpaceDrawerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSpaceDrawerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSpaceDrawerMethod "getTypesForLocations" o = SpaceDrawerGetTypesForLocationsMethodInfo
    ResolveSpaceDrawerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSpaceDrawerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSpaceDrawerMethod "setEnableMatrix" o = SpaceDrawerSetEnableMatrixMethodInfo
    ResolveSpaceDrawerMethod "setMatrix" o = SpaceDrawerSetMatrixMethodInfo
    ResolveSpaceDrawerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSpaceDrawerMethod "setTypesForLocations" o = SpaceDrawerSetTypesForLocationsMethodInfo
    ResolveSpaceDrawerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

-- | Get the value of the “@enable-matrix@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' spaceDrawer #enableMatrix
-- @
getSpaceDrawerEnableMatrix :: (MonadIO m, IsSpaceDrawer o) => o -> m Bool
getSpaceDrawerEnableMatrix :: o -> m Bool
getSpaceDrawerEnableMatrix obj :: o
obj = 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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "enable-matrix"

-- | Set the value of the “@enable-matrix@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' spaceDrawer [ #enableMatrix 'Data.GI.Base.Attributes.:=' value ]
-- @
setSpaceDrawerEnableMatrix :: (MonadIO m, IsSpaceDrawer o) => o -> Bool -> m ()
setSpaceDrawerEnableMatrix :: o -> Bool -> m ()
setSpaceDrawerEnableMatrix obj :: o
obj val :: Bool
val = 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 -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "enable-matrix" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@enable-matrix@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSpaceDrawerEnableMatrix :: (IsSpaceDrawer o) => Bool -> IO (GValueConstruct o)
constructSpaceDrawerEnableMatrix :: Bool -> IO (GValueConstruct o)
constructSpaceDrawerEnableMatrix val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "enable-matrix" Bool
val

#if defined(ENABLE_OVERLOADING)
data SpaceDrawerEnableMatrixPropertyInfo
instance AttrInfo SpaceDrawerEnableMatrixPropertyInfo where
    type AttrAllowedOps SpaceDrawerEnableMatrixPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SpaceDrawerEnableMatrixPropertyInfo = IsSpaceDrawer
    type AttrSetTypeConstraint SpaceDrawerEnableMatrixPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SpaceDrawerEnableMatrixPropertyInfo = (~) Bool
    type AttrTransferType SpaceDrawerEnableMatrixPropertyInfo = Bool
    type AttrGetType SpaceDrawerEnableMatrixPropertyInfo = Bool
    type AttrLabel SpaceDrawerEnableMatrixPropertyInfo = "enable-matrix"
    type AttrOrigin SpaceDrawerEnableMatrixPropertyInfo = SpaceDrawer
    attrGet = getSpaceDrawerEnableMatrix
    attrSet = setSpaceDrawerEnableMatrix
    attrTransfer _ v = do
        return v
    attrConstruct = constructSpaceDrawerEnableMatrix
    attrClear = undefined
#endif

-- VVV Prop "matrix"
   -- Type: TVariant
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Just True)

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

-- | Set the value of the “@matrix@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' spaceDrawer [ #matrix 'Data.GI.Base.Attributes.:=' value ]
-- @
setSpaceDrawerMatrix :: (MonadIO m, IsSpaceDrawer o) => o -> GVariant -> m ()
setSpaceDrawerMatrix :: o -> GVariant -> m ()
setSpaceDrawerMatrix obj :: o
obj val :: GVariant
val = 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 GVariant -> IO ()
forall a. GObject a => a -> String -> Maybe GVariant -> IO ()
B.Properties.setObjectPropertyVariant o
obj "matrix" (GVariant -> Maybe GVariant
forall a. a -> Maybe a
Just GVariant
val)

-- | Construct a `GValueConstruct` with valid value for the “@matrix@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSpaceDrawerMatrix :: (IsSpaceDrawer o) => GVariant -> IO (GValueConstruct o)
constructSpaceDrawerMatrix :: GVariant -> IO (GValueConstruct o)
constructSpaceDrawerMatrix val :: GVariant
val = String -> Maybe GVariant -> IO (GValueConstruct o)
forall o. String -> Maybe GVariant -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyVariant "matrix" (GVariant -> Maybe GVariant
forall a. a -> Maybe a
Just GVariant
val)

-- | Set the value of the “@matrix@” 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' #matrix
-- @
clearSpaceDrawerMatrix :: (MonadIO m, IsSpaceDrawer o) => o -> m ()
clearSpaceDrawerMatrix :: o -> m ()
clearSpaceDrawerMatrix obj :: 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 GVariant -> IO ()
forall a. GObject a => a -> String -> Maybe GVariant -> IO ()
B.Properties.setObjectPropertyVariant o
obj "matrix" (Maybe GVariant
forall a. Maybe a
Nothing :: Maybe GVariant)

#if defined(ENABLE_OVERLOADING)
data SpaceDrawerMatrixPropertyInfo
instance AttrInfo SpaceDrawerMatrixPropertyInfo where
    type AttrAllowedOps SpaceDrawerMatrixPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SpaceDrawerMatrixPropertyInfo = IsSpaceDrawer
    type AttrSetTypeConstraint SpaceDrawerMatrixPropertyInfo = (~) GVariant
    type AttrTransferTypeConstraint SpaceDrawerMatrixPropertyInfo = (~) GVariant
    type AttrTransferType SpaceDrawerMatrixPropertyInfo = GVariant
    type AttrGetType SpaceDrawerMatrixPropertyInfo = (Maybe GVariant)
    type AttrLabel SpaceDrawerMatrixPropertyInfo = "matrix"
    type AttrOrigin SpaceDrawerMatrixPropertyInfo = SpaceDrawer
    attrGet = getSpaceDrawerMatrix
    attrSet = setSpaceDrawerMatrix
    attrTransfer _ v = do
        return v
    attrConstruct = constructSpaceDrawerMatrix
    attrClear = clearSpaceDrawerMatrix
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SpaceDrawer
type instance O.AttributeList SpaceDrawer = SpaceDrawerAttributeList
type SpaceDrawerAttributeList = ('[ '("enableMatrix", SpaceDrawerEnableMatrixPropertyInfo), '("matrix", SpaceDrawerMatrixPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
spaceDrawerEnableMatrix :: AttrLabelProxy "enableMatrix"
spaceDrawerEnableMatrix = AttrLabelProxy

spaceDrawerMatrix :: AttrLabelProxy "matrix"
spaceDrawerMatrix = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "gtk_source_space_drawer_new" gtk_source_space_drawer_new :: 
    IO (Ptr SpaceDrawer)

-- | Creates a new t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer' object. Useful for storing space drawing
-- settings independently of a t'GI.GtkSource.Objects.View.View'.
-- 
-- /Since: 3.24/
spaceDrawerNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m SpaceDrawer
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer'.
spaceDrawerNew :: m SpaceDrawer
spaceDrawerNew  = IO SpaceDrawer -> m SpaceDrawer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SpaceDrawer -> m SpaceDrawer)
-> IO SpaceDrawer -> m SpaceDrawer
forall a b. (a -> b) -> a -> b
$ do
    Ptr SpaceDrawer
result <- IO (Ptr SpaceDrawer)
gtk_source_space_drawer_new
    Text -> Ptr SpaceDrawer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "spaceDrawerNew" Ptr SpaceDrawer
result
    SpaceDrawer
result' <- ((ManagedPtr SpaceDrawer -> SpaceDrawer)
-> Ptr SpaceDrawer -> IO SpaceDrawer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SpaceDrawer -> SpaceDrawer
SpaceDrawer) Ptr SpaceDrawer
result
    SpaceDrawer -> IO SpaceDrawer
forall (m :: * -> *) a. Monad m => a -> m a
return SpaceDrawer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SpaceDrawer::bind_matrix_setting
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "drawer"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SpaceDrawer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSpaceDrawer object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "settings"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Settings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSettings object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the @settings key to bind."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SettingsBindFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags for the binding."
--                 , 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_space_drawer_bind_matrix_setting" gtk_source_space_drawer_bind_matrix_setting :: 
    Ptr SpaceDrawer ->                      -- drawer : TInterface (Name {namespace = "GtkSource", name = "SpaceDrawer"})
    Ptr Gio.Settings.Settings ->            -- settings : TInterface (Name {namespace = "Gio", name = "Settings"})
    CString ->                              -- key : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "SettingsBindFlags"})
    IO ()

-- | Binds the t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ property to a t'GI.Gio.Objects.Settings.Settings' key.
-- 
-- The t'GI.Gio.Objects.Settings.Settings' key must be of the same type as the
-- t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ property, that is, @\"au\"@.
-- 
-- The 'GI.Gio.Objects.Settings.settingsBind' function cannot be used, because the default GIO
-- mapping functions don\'t support t'GVariant' properties (maybe it will be
-- supported by a future GIO version, in which case this function can be
-- deprecated).
-- 
-- /Since: 3.24/
spaceDrawerBindMatrixSetting ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpaceDrawer a, Gio.Settings.IsSettings b) =>
    a
    -- ^ /@drawer@/: a t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer' object.
    -> b
    -- ^ /@settings@/: a t'GI.Gio.Objects.Settings.Settings' object.
    -> T.Text
    -- ^ /@key@/: the /@settings@/ key to bind.
    -> [Gio.Flags.SettingsBindFlags]
    -- ^ /@flags@/: flags for the binding.
    -> m ()
spaceDrawerBindMatrixSetting :: a -> b -> Text -> [SettingsBindFlags] -> m ()
spaceDrawerBindMatrixSetting drawer :: a
drawer settings :: b
settings key :: Text
key flags :: [SettingsBindFlags]
flags = 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 SpaceDrawer
drawer' <- a -> IO (Ptr SpaceDrawer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drawer
    Ptr Settings
settings' <- b -> IO (Ptr Settings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
settings
    CString
key' <- Text -> IO CString
textToCString Text
key
    let flags' :: CUInt
flags' = [SettingsBindFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SettingsBindFlags]
flags
    Ptr SpaceDrawer -> Ptr Settings -> CString -> CUInt -> IO ()
gtk_source_space_drawer_bind_matrix_setting Ptr SpaceDrawer
drawer' Ptr Settings
settings' CString
key' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drawer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
settings
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpaceDrawerBindMatrixSettingMethodInfo
instance (signature ~ (b -> T.Text -> [Gio.Flags.SettingsBindFlags] -> m ()), MonadIO m, IsSpaceDrawer a, Gio.Settings.IsSettings b) => O.MethodInfo SpaceDrawerBindMatrixSettingMethodInfo a signature where
    overloadedMethod = spaceDrawerBindMatrixSetting

#endif

-- method SpaceDrawer::get_enable_matrix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "drawer"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SpaceDrawer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSpaceDrawer."
--                 , 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_space_drawer_get_enable_matrix" gtk_source_space_drawer_get_enable_matrix :: 
    Ptr SpaceDrawer ->                      -- drawer : TInterface (Name {namespace = "GtkSource", name = "SpaceDrawer"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.24/
spaceDrawerGetEnableMatrix ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpaceDrawer a) =>
    a
    -- ^ /@drawer@/: a t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer'.
    -> m Bool
    -- ^ __Returns:__ whether the t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ property is enabled.
spaceDrawerGetEnableMatrix :: a -> m Bool
spaceDrawerGetEnableMatrix drawer :: a
drawer = 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 SpaceDrawer
drawer' <- a -> IO (Ptr SpaceDrawer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drawer
    CInt
result <- Ptr SpaceDrawer -> IO CInt
gtk_source_space_drawer_get_enable_matrix Ptr SpaceDrawer
drawer'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drawer
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SpaceDrawerGetEnableMatrixMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSpaceDrawer a) => O.MethodInfo SpaceDrawerGetEnableMatrixMethodInfo a signature where
    overloadedMethod = spaceDrawerGetEnableMatrix

#endif

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

foreign import ccall "gtk_source_space_drawer_get_matrix" gtk_source_space_drawer_get_matrix :: 
    Ptr SpaceDrawer ->                      -- drawer : TInterface (Name {namespace = "GtkSource", name = "SpaceDrawer"})
    IO (Ptr GVariant)

-- | Gets the value of the t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ property, as a t'GVariant'.
-- An empty array can be returned in case the matrix is a zero matrix.
-- 
-- The 'GI.GtkSource.Objects.SpaceDrawer.spaceDrawerGetTypesForLocations' function may be more
-- convenient to use.
-- 
-- /Since: 3.24/
spaceDrawerGetMatrix ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpaceDrawer a) =>
    a
    -- ^ /@drawer@/: a t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer'.
    -> m GVariant
    -- ^ __Returns:__ the t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ value as a new floating t'GVariant'
    --   instance.
spaceDrawerGetMatrix :: a -> m GVariant
spaceDrawerGetMatrix drawer :: a
drawer = IO GVariant -> m GVariant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr SpaceDrawer
drawer' <- a -> IO (Ptr SpaceDrawer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drawer
    Ptr GVariant
result <- Ptr SpaceDrawer -> IO (Ptr GVariant)
gtk_source_space_drawer_get_matrix Ptr SpaceDrawer
drawer'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "spaceDrawerGetMatrix" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drawer
    GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data SpaceDrawerGetMatrixMethodInfo
instance (signature ~ (m GVariant), MonadIO m, IsSpaceDrawer a) => O.MethodInfo SpaceDrawerGetMatrixMethodInfo a signature where
    overloadedMethod = spaceDrawerGetMatrix

#endif

-- method SpaceDrawer::get_types_for_locations
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "drawer"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SpaceDrawer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSpaceDrawer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "locations"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SpaceLocationFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "one or several #GtkSourceSpaceLocationFlags."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkSource" , name = "SpaceTypeFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_space_drawer_get_types_for_locations" gtk_source_space_drawer_get_types_for_locations :: 
    Ptr SpaceDrawer ->                      -- drawer : TInterface (Name {namespace = "GtkSource", name = "SpaceDrawer"})
    CUInt ->                                -- locations : TInterface (Name {namespace = "GtkSource", name = "SpaceLocationFlags"})
    IO CUInt

-- | If only one location is specified, this function returns what kind of
-- white spaces are drawn at that location. The value is retrieved from the
-- t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ property.
-- 
-- If several locations are specified, this function returns the logical AND for
-- those locations. Which means that if a certain kind of white space is present
-- in the return value, then that kind of white space is drawn at all the
-- specified /@locations@/.
-- 
-- /Since: 3.24/
spaceDrawerGetTypesForLocations ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpaceDrawer a) =>
    a
    -- ^ /@drawer@/: a t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer'.
    -> [GtkSource.Flags.SpaceLocationFlags]
    -- ^ /@locations@/: one or several t'GI.GtkSource.Flags.SpaceLocationFlags'.
    -> m [GtkSource.Flags.SpaceTypeFlags]
    -- ^ __Returns:__ a combination of t'GI.GtkSource.Flags.SpaceTypeFlags'.
spaceDrawerGetTypesForLocations :: a -> [SpaceLocationFlags] -> m [SpaceTypeFlags]
spaceDrawerGetTypesForLocations drawer :: a
drawer locations :: [SpaceLocationFlags]
locations = IO [SpaceTypeFlags] -> m [SpaceTypeFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SpaceTypeFlags] -> m [SpaceTypeFlags])
-> IO [SpaceTypeFlags] -> m [SpaceTypeFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr SpaceDrawer
drawer' <- a -> IO (Ptr SpaceDrawer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drawer
    let locations' :: CUInt
locations' = [SpaceLocationFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SpaceLocationFlags]
locations
    CUInt
result <- Ptr SpaceDrawer -> CUInt -> IO CUInt
gtk_source_space_drawer_get_types_for_locations Ptr SpaceDrawer
drawer' CUInt
locations'
    let result' :: [SpaceTypeFlags]
result' = CUInt -> [SpaceTypeFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drawer
    [SpaceTypeFlags] -> IO [SpaceTypeFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [SpaceTypeFlags]
result'

#if defined(ENABLE_OVERLOADING)
data SpaceDrawerGetTypesForLocationsMethodInfo
instance (signature ~ ([GtkSource.Flags.SpaceLocationFlags] -> m [GtkSource.Flags.SpaceTypeFlags]), MonadIO m, IsSpaceDrawer a) => O.MethodInfo SpaceDrawerGetTypesForLocationsMethodInfo a signature where
    overloadedMethod = spaceDrawerGetTypesForLocations

#endif

-- method SpaceDrawer::set_enable_matrix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "drawer"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SpaceDrawer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSpaceDrawer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enable_matrix"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value." , 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_space_drawer_set_enable_matrix" gtk_source_space_drawer_set_enable_matrix :: 
    Ptr SpaceDrawer ->                      -- drawer : TInterface (Name {namespace = "GtkSource", name = "SpaceDrawer"})
    CInt ->                                 -- enable_matrix : TBasicType TBoolean
    IO ()

-- | Sets whether the t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ property is enabled.
-- 
-- /Since: 3.24/
spaceDrawerSetEnableMatrix ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpaceDrawer a) =>
    a
    -- ^ /@drawer@/: a t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer'.
    -> Bool
    -- ^ /@enableMatrix@/: the new value.
    -> m ()
spaceDrawerSetEnableMatrix :: a -> Bool -> m ()
spaceDrawerSetEnableMatrix drawer :: a
drawer enableMatrix :: Bool
enableMatrix = 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 SpaceDrawer
drawer' <- a -> IO (Ptr SpaceDrawer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drawer
    let enableMatrix' :: CInt
enableMatrix' = (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
enableMatrix
    Ptr SpaceDrawer -> CInt -> IO ()
gtk_source_space_drawer_set_enable_matrix Ptr SpaceDrawer
drawer' CInt
enableMatrix'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drawer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpaceDrawerSetEnableMatrixMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSpaceDrawer a) => O.MethodInfo SpaceDrawerSetEnableMatrixMethodInfo a signature where
    overloadedMethod = spaceDrawerSetEnableMatrix

#endif

-- method SpaceDrawer::set_matrix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "drawer"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SpaceDrawer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSpaceDrawer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "matrix"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new matrix value, 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_space_drawer_set_matrix" gtk_source_space_drawer_set_matrix :: 
    Ptr SpaceDrawer ->                      -- drawer : TInterface (Name {namespace = "GtkSource", name = "SpaceDrawer"})
    Ptr GVariant ->                         -- matrix : TVariant
    IO ()

-- | Sets a new value to the t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ property, as a
-- t'GVariant'. If /@matrix@/ is 'P.Nothing', then an empty array is set.
-- 
-- If /@matrix@/ is floating, it is consumed.
-- 
-- The 'GI.GtkSource.Objects.SpaceDrawer.spaceDrawerSetTypesForLocations' function may be more
-- convenient to use.
-- 
-- /Since: 3.24/
spaceDrawerSetMatrix ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpaceDrawer a) =>
    a
    -- ^ /@drawer@/: a t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer'.
    -> Maybe (GVariant)
    -- ^ /@matrix@/: the new matrix value, or 'P.Nothing'.
    -> m ()
spaceDrawerSetMatrix :: a -> Maybe GVariant -> m ()
spaceDrawerSetMatrix drawer :: a
drawer matrix :: Maybe GVariant
matrix = 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 SpaceDrawer
drawer' <- a -> IO (Ptr SpaceDrawer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drawer
    Ptr GVariant
maybeMatrix <- case Maybe GVariant
matrix of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jMatrix :: GVariant
jMatrix -> do
            Ptr GVariant
jMatrix' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jMatrix
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jMatrix'
    Ptr SpaceDrawer -> Ptr GVariant -> IO ()
gtk_source_space_drawer_set_matrix Ptr SpaceDrawer
drawer' Ptr GVariant
maybeMatrix
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drawer
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
matrix GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpaceDrawerSetMatrixMethodInfo
instance (signature ~ (Maybe (GVariant) -> m ()), MonadIO m, IsSpaceDrawer a) => O.MethodInfo SpaceDrawerSetMatrixMethodInfo a signature where
    overloadedMethod = spaceDrawerSetMatrix

#endif

-- method SpaceDrawer::set_types_for_locations
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "drawer"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SpaceDrawer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSpaceDrawer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "locations"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SpaceLocationFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "one or several #GtkSourceSpaceLocationFlags."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "types"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SpaceTypeFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a combination of #GtkSourceSpaceTypeFlags."
--                 , 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_space_drawer_set_types_for_locations" gtk_source_space_drawer_set_types_for_locations :: 
    Ptr SpaceDrawer ->                      -- drawer : TInterface (Name {namespace = "GtkSource", name = "SpaceDrawer"})
    CUInt ->                                -- locations : TInterface (Name {namespace = "GtkSource", name = "SpaceLocationFlags"})
    CUInt ->                                -- types : TInterface (Name {namespace = "GtkSource", name = "SpaceTypeFlags"})
    IO ()

-- | Modifies the t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ property at the specified
-- /@locations@/.
-- 
-- /Since: 3.24/
spaceDrawerSetTypesForLocations ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpaceDrawer a) =>
    a
    -- ^ /@drawer@/: a t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer'.
    -> [GtkSource.Flags.SpaceLocationFlags]
    -- ^ /@locations@/: one or several t'GI.GtkSource.Flags.SpaceLocationFlags'.
    -> [GtkSource.Flags.SpaceTypeFlags]
    -- ^ /@types@/: a combination of t'GI.GtkSource.Flags.SpaceTypeFlags'.
    -> m ()
spaceDrawerSetTypesForLocations :: a -> [SpaceLocationFlags] -> [SpaceTypeFlags] -> m ()
spaceDrawerSetTypesForLocations drawer :: a
drawer locations :: [SpaceLocationFlags]
locations types :: [SpaceTypeFlags]
types = 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 SpaceDrawer
drawer' <- a -> IO (Ptr SpaceDrawer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drawer
    let locations' :: CUInt
locations' = [SpaceLocationFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SpaceLocationFlags]
locations
    let types' :: CUInt
types' = [SpaceTypeFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SpaceTypeFlags]
types
    Ptr SpaceDrawer -> CUInt -> CUInt -> IO ()
gtk_source_space_drawer_set_types_for_locations Ptr SpaceDrawer
drawer' CUInt
locations' CUInt
types'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drawer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpaceDrawerSetTypesForLocationsMethodInfo
instance (signature ~ ([GtkSource.Flags.SpaceLocationFlags] -> [GtkSource.Flags.SpaceTypeFlags] -> m ()), MonadIO m, IsSpaceDrawer a) => O.MethodInfo SpaceDrawerSetTypesForLocationsMethodInfo a signature where
    overloadedMethod = spaceDrawerSetTypesForLocations

#endif