{-# LANGUAGE TypeApplications #-}


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

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

module GI.GtkSource.Objects.Tag
    ( 

-- * Exported types
    Tag(..)                                 ,
    IsTag                                   ,
    toTag                                   ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [changed]("GI.Gtk.Objects.TextTag#g:method:changed"), [event]("GI.Gtk.Objects.TextTag#g:method:event"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getPriority]("GI.Gtk.Objects.TextTag#g:method:getPriority"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setPriority]("GI.Gtk.Objects.TextTag#g:method:setPriority"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveTagMethod                        ,
#endif

-- ** new #method:new#

    tagNew                                  ,




 -- * Properties


-- ** drawSpaces #attr:drawSpaces#
-- | Whether to draw white spaces. This property takes precedence over the value
-- defined by the GtkSourceSpaceDrawer\'s t'GI.GtkSource.Objects.SpaceDrawer.SpaceDrawer':@/matrix/@ property
-- (only where the tag is applied).
-- 
-- Setting this property also changes t'GI.GtkSource.Objects.Tag.Tag':@/draw-spaces-set/@ to
-- 'P.True'.
-- 
-- /Since: 3.20/

#if defined(ENABLE_OVERLOADING)
    TagDrawSpacesPropertyInfo               ,
#endif
    constructTagDrawSpaces                  ,
    getTagDrawSpaces                        ,
    setTagDrawSpaces                        ,
#if defined(ENABLE_OVERLOADING)
    tagDrawSpaces                           ,
#endif


-- ** drawSpacesSet #attr:drawSpacesSet#
-- | Whether the t'GI.GtkSource.Objects.Tag.Tag':@/draw-spaces/@ property is set and must be
-- taken into account.
-- 
-- /Since: 3.20/

#if defined(ENABLE_OVERLOADING)
    TagDrawSpacesSetPropertyInfo            ,
#endif
    constructTagDrawSpacesSet               ,
    getTagDrawSpacesSet                     ,
    setTagDrawSpacesSet                     ,
#if defined(ENABLE_OVERLOADING)
    tagDrawSpacesSet                        ,
#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.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.TextTag as Gtk.TextTag

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

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

foreign import ccall "gtk_source_tag_get_type"
    c_gtk_source_tag_get_type :: IO B.Types.GType

instance B.Types.TypedObject Tag where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_tag_get_type

instance B.Types.GObject Tag

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

instance O.HasParentTypes Tag
type instance O.ParentTypes Tag = '[Gtk.TextTag.TextTag, GObject.Object.Object]

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

-- | Convert 'Tag' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Tag) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_source_tag_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Tag -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Tag
P.Nothing = Ptr GValue -> Ptr Tag -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Tag
forall a. Ptr a
FP.nullPtr :: FP.Ptr Tag)
    gvalueSet_ Ptr GValue
gv (P.Just Tag
obj) = Tag -> (Ptr Tag -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Tag
obj (Ptr GValue -> Ptr Tag -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Tag)
gvalueGet_ Ptr GValue
gv = do
        Ptr Tag
ptr <- Ptr GValue -> IO (Ptr Tag)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Tag)
        if Ptr Tag
ptr Ptr Tag -> Ptr Tag -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Tag
forall a. Ptr a
FP.nullPtr
        then Tag -> Maybe Tag
forall a. a -> Maybe a
P.Just (Tag -> Maybe Tag) -> IO Tag -> IO (Maybe Tag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Tag -> Tag) -> Ptr Tag -> IO Tag
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Tag -> Tag
Tag Ptr Tag
ptr
        else Maybe Tag -> IO (Maybe Tag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Tag
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveTagMethod (t :: Symbol) (o :: *) :: * where
    ResolveTagMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTagMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTagMethod "changed" o = Gtk.TextTag.TextTagChangedMethodInfo
    ResolveTagMethod "event" o = Gtk.TextTag.TextTagEventMethodInfo
    ResolveTagMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTagMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTagMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTagMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTagMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTagMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTagMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTagMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTagMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTagMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTagMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTagMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTagMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTagMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTagMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTagMethod "getPriority" o = Gtk.TextTag.TextTagGetPriorityMethodInfo
    ResolveTagMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTagMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTagMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTagMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTagMethod "setPriority" o = Gtk.TextTag.TextTagSetPriorityMethodInfo
    ResolveTagMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTagMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveTagMethod t Tag, O.OverloadedMethod info Tag p, R.HasField t Tag p) => R.HasField t Tag p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- VVV Prop "draw-spaces"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@draw-spaces@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTagDrawSpaces :: (IsTag o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTagDrawSpaces :: forall o (m :: * -> *).
(IsTag o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTagDrawSpaces Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"draw-spaces" Bool
val

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

-- VVV Prop "draw-spaces-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@draw-spaces-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTagDrawSpacesSet :: (IsTag o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTagDrawSpacesSet :: forall o (m :: * -> *).
(IsTag o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTagDrawSpacesSet Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"draw-spaces-set" Bool
val

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Tag
type instance O.AttributeList Tag = TagAttributeList
type TagAttributeList = ('[ '("accumulativeMargin", Gtk.TextTag.TextTagAccumulativeMarginPropertyInfo), '("background", Gtk.TextTag.TextTagBackgroundPropertyInfo), '("backgroundFullHeight", Gtk.TextTag.TextTagBackgroundFullHeightPropertyInfo), '("backgroundFullHeightSet", Gtk.TextTag.TextTagBackgroundFullHeightSetPropertyInfo), '("backgroundGdk", Gtk.TextTag.TextTagBackgroundGdkPropertyInfo), '("backgroundRgba", Gtk.TextTag.TextTagBackgroundRgbaPropertyInfo), '("backgroundSet", Gtk.TextTag.TextTagBackgroundSetPropertyInfo), '("direction", Gtk.TextTag.TextTagDirectionPropertyInfo), '("drawSpaces", TagDrawSpacesPropertyInfo), '("drawSpacesSet", TagDrawSpacesSetPropertyInfo), '("editable", Gtk.TextTag.TextTagEditablePropertyInfo), '("editableSet", Gtk.TextTag.TextTagEditableSetPropertyInfo), '("fallback", Gtk.TextTag.TextTagFallbackPropertyInfo), '("fallbackSet", Gtk.TextTag.TextTagFallbackSetPropertyInfo), '("family", Gtk.TextTag.TextTagFamilyPropertyInfo), '("familySet", Gtk.TextTag.TextTagFamilySetPropertyInfo), '("font", Gtk.TextTag.TextTagFontPropertyInfo), '("fontDesc", Gtk.TextTag.TextTagFontDescPropertyInfo), '("fontFeatures", Gtk.TextTag.TextTagFontFeaturesPropertyInfo), '("fontFeaturesSet", Gtk.TextTag.TextTagFontFeaturesSetPropertyInfo), '("foreground", Gtk.TextTag.TextTagForegroundPropertyInfo), '("foregroundGdk", Gtk.TextTag.TextTagForegroundGdkPropertyInfo), '("foregroundRgba", Gtk.TextTag.TextTagForegroundRgbaPropertyInfo), '("foregroundSet", Gtk.TextTag.TextTagForegroundSetPropertyInfo), '("indent", Gtk.TextTag.TextTagIndentPropertyInfo), '("indentSet", Gtk.TextTag.TextTagIndentSetPropertyInfo), '("invisible", Gtk.TextTag.TextTagInvisiblePropertyInfo), '("invisibleSet", Gtk.TextTag.TextTagInvisibleSetPropertyInfo), '("justification", Gtk.TextTag.TextTagJustificationPropertyInfo), '("justificationSet", Gtk.TextTag.TextTagJustificationSetPropertyInfo), '("language", Gtk.TextTag.TextTagLanguagePropertyInfo), '("languageSet", Gtk.TextTag.TextTagLanguageSetPropertyInfo), '("leftMargin", Gtk.TextTag.TextTagLeftMarginPropertyInfo), '("leftMarginSet", Gtk.TextTag.TextTagLeftMarginSetPropertyInfo), '("letterSpacing", Gtk.TextTag.TextTagLetterSpacingPropertyInfo), '("letterSpacingSet", Gtk.TextTag.TextTagLetterSpacingSetPropertyInfo), '("name", Gtk.TextTag.TextTagNamePropertyInfo), '("paragraphBackground", Gtk.TextTag.TextTagParagraphBackgroundPropertyInfo), '("paragraphBackgroundGdk", Gtk.TextTag.TextTagParagraphBackgroundGdkPropertyInfo), '("paragraphBackgroundRgba", Gtk.TextTag.TextTagParagraphBackgroundRgbaPropertyInfo), '("paragraphBackgroundSet", Gtk.TextTag.TextTagParagraphBackgroundSetPropertyInfo), '("pixelsAboveLines", Gtk.TextTag.TextTagPixelsAboveLinesPropertyInfo), '("pixelsAboveLinesSet", Gtk.TextTag.TextTagPixelsAboveLinesSetPropertyInfo), '("pixelsBelowLines", Gtk.TextTag.TextTagPixelsBelowLinesPropertyInfo), '("pixelsBelowLinesSet", Gtk.TextTag.TextTagPixelsBelowLinesSetPropertyInfo), '("pixelsInsideWrap", Gtk.TextTag.TextTagPixelsInsideWrapPropertyInfo), '("pixelsInsideWrapSet", Gtk.TextTag.TextTagPixelsInsideWrapSetPropertyInfo), '("rightMargin", Gtk.TextTag.TextTagRightMarginPropertyInfo), '("rightMarginSet", Gtk.TextTag.TextTagRightMarginSetPropertyInfo), '("rise", Gtk.TextTag.TextTagRisePropertyInfo), '("riseSet", Gtk.TextTag.TextTagRiseSetPropertyInfo), '("scale", Gtk.TextTag.TextTagScalePropertyInfo), '("scaleSet", Gtk.TextTag.TextTagScaleSetPropertyInfo), '("size", Gtk.TextTag.TextTagSizePropertyInfo), '("sizePoints", Gtk.TextTag.TextTagSizePointsPropertyInfo), '("sizeSet", Gtk.TextTag.TextTagSizeSetPropertyInfo), '("stretch", Gtk.TextTag.TextTagStretchPropertyInfo), '("stretchSet", Gtk.TextTag.TextTagStretchSetPropertyInfo), '("strikethrough", Gtk.TextTag.TextTagStrikethroughPropertyInfo), '("strikethroughRgba", Gtk.TextTag.TextTagStrikethroughRgbaPropertyInfo), '("strikethroughRgbaSet", Gtk.TextTag.TextTagStrikethroughRgbaSetPropertyInfo), '("strikethroughSet", Gtk.TextTag.TextTagStrikethroughSetPropertyInfo), '("style", Gtk.TextTag.TextTagStylePropertyInfo), '("styleSet", Gtk.TextTag.TextTagStyleSetPropertyInfo), '("tabs", Gtk.TextTag.TextTagTabsPropertyInfo), '("tabsSet", Gtk.TextTag.TextTagTabsSetPropertyInfo), '("underline", Gtk.TextTag.TextTagUnderlinePropertyInfo), '("underlineRgba", Gtk.TextTag.TextTagUnderlineRgbaPropertyInfo), '("underlineRgbaSet", Gtk.TextTag.TextTagUnderlineRgbaSetPropertyInfo), '("underlineSet", Gtk.TextTag.TextTagUnderlineSetPropertyInfo), '("variant", Gtk.TextTag.TextTagVariantPropertyInfo), '("variantSet", Gtk.TextTag.TextTagVariantSetPropertyInfo), '("weight", Gtk.TextTag.TextTagWeightPropertyInfo), '("weightSet", Gtk.TextTag.TextTagWeightSetPropertyInfo), '("wrapMode", Gtk.TextTag.TextTagWrapModePropertyInfo), '("wrapModeSet", Gtk.TextTag.TextTagWrapModeSetPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
tagDrawSpaces :: AttrLabelProxy "drawSpaces"
tagDrawSpaces = AttrLabelProxy

tagDrawSpacesSet :: AttrLabelProxy "drawSpacesSet"
tagDrawSpacesSet = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Tag = TagSignalList
type TagSignalList = ('[ '("event", Gtk.TextTag.TextTagEventSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_source_tag_new" gtk_source_tag_new :: 
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Tag)

-- | Creates a t'GI.GtkSource.Objects.Tag.Tag'. Configure the tag using object arguments,
-- i.e. using @/g_object_set()/@.
-- 
-- For usual cases, @/gtk_source_buffer_create_source_tag()/@ is more convenient to
-- use.
-- 
-- /Since: 3.20/
tagNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@name@/: tag name, or 'P.Nothing'.
    -> m Tag
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.Tag.Tag'.
tagNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Tag
tagNew Maybe Text
name = IO Tag -> m Tag
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Tag -> m Tag) -> IO Tag -> m Tag
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            Ptr CChar
jName' <- Text -> IO (Ptr CChar)
textToCString Text
jName
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jName'
    Ptr Tag
result <- Ptr CChar -> IO (Ptr Tag)
gtk_source_tag_new Ptr CChar
maybeName
    Text -> Ptr Tag -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tagNew" Ptr Tag
result
    Tag
result' <- ((ManagedPtr Tag -> Tag) -> Ptr Tag -> IO Tag
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Tag -> Tag
Tag) Ptr Tag
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    Tag -> IO Tag
forall (m :: * -> *) a. Monad m => a -> m a
return Tag
result'

#if defined(ENABLE_OVERLOADING)
#endif