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

-- * Exported types
    MarkAttributes(..)                      ,
    IsMarkAttributes                        ,
    toMarkAttributes                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [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"), [renderIcon]("GI.GtkSource.Objects.MarkAttributes#g:method:renderIcon"), [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
-- [getBackground]("GI.GtkSource.Objects.MarkAttributes#g:method:getBackground"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getGicon]("GI.GtkSource.Objects.MarkAttributes#g:method:getGicon"), [getIconName]("GI.GtkSource.Objects.MarkAttributes#g:method:getIconName"), [getPixbuf]("GI.GtkSource.Objects.MarkAttributes#g:method:getPixbuf"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getStockId]("GI.GtkSource.Objects.MarkAttributes#g:method:getStockId"), [getTooltipMarkup]("GI.GtkSource.Objects.MarkAttributes#g:method:getTooltipMarkup"), [getTooltipText]("GI.GtkSource.Objects.MarkAttributes#g:method:getTooltipText").
-- 
-- ==== Setters
-- [setBackground]("GI.GtkSource.Objects.MarkAttributes#g:method:setBackground"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setGicon]("GI.GtkSource.Objects.MarkAttributes#g:method:setGicon"), [setIconName]("GI.GtkSource.Objects.MarkAttributes#g:method:setIconName"), [setPixbuf]("GI.GtkSource.Objects.MarkAttributes#g:method:setPixbuf"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setStockId]("GI.GtkSource.Objects.MarkAttributes#g:method:setStockId").

#if defined(ENABLE_OVERLOADING)
    ResolveMarkAttributesMethod             ,
#endif

-- ** getBackground #method:getBackground#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesGetBackgroundMethodInfo   ,
#endif
    markAttributesGetBackground             ,


-- ** getGicon #method:getGicon#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesGetGiconMethodInfo        ,
#endif
    markAttributesGetGicon                  ,


-- ** getIconName #method:getIconName#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesGetIconNameMethodInfo     ,
#endif
    markAttributesGetIconName               ,


-- ** getPixbuf #method:getPixbuf#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesGetPixbufMethodInfo       ,
#endif
    markAttributesGetPixbuf                 ,


-- ** getStockId #method:getStockId#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesGetStockIdMethodInfo      ,
#endif
    markAttributesGetStockId                ,


-- ** getTooltipMarkup #method:getTooltipMarkup#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesGetTooltipMarkupMethodInfo,
#endif
    markAttributesGetTooltipMarkup          ,


-- ** getTooltipText #method:getTooltipText#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesGetTooltipTextMethodInfo  ,
#endif
    markAttributesGetTooltipText            ,


-- ** new #method:new#

    markAttributesNew                       ,


-- ** renderIcon #method:renderIcon#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesRenderIconMethodInfo      ,
#endif
    markAttributesRenderIcon                ,


-- ** setBackground #method:setBackground#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesSetBackgroundMethodInfo   ,
#endif
    markAttributesSetBackground             ,


-- ** setGicon #method:setGicon#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesSetGiconMethodInfo        ,
#endif
    markAttributesSetGicon                  ,


-- ** setIconName #method:setIconName#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesSetIconNameMethodInfo     ,
#endif
    markAttributesSetIconName               ,


-- ** setPixbuf #method:setPixbuf#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesSetPixbufMethodInfo       ,
#endif
    markAttributesSetPixbuf                 ,


-- ** setStockId #method:setStockId#

#if defined(ENABLE_OVERLOADING)
    MarkAttributesSetStockIdMethodInfo      ,
#endif
    markAttributesSetStockId                ,




 -- * Properties


-- ** background #attr:background#
-- | A color used for background of a line.

#if defined(ENABLE_OVERLOADING)
    MarkAttributesBackgroundPropertyInfo    ,
#endif
    constructMarkAttributesBackground       ,
    getMarkAttributesBackground             ,
#if defined(ENABLE_OVERLOADING)
    markAttributesBackground                ,
#endif
    setMarkAttributesBackground             ,


-- ** gicon #attr:gicon#
-- | A t'GI.Gio.Interfaces.Icon.Icon' that may be a base of a rendered icon.

#if defined(ENABLE_OVERLOADING)
    MarkAttributesGiconPropertyInfo         ,
#endif
    constructMarkAttributesGicon            ,
    getMarkAttributesGicon                  ,
#if defined(ENABLE_OVERLOADING)
    markAttributesGicon                     ,
#endif
    setMarkAttributesGicon                  ,


-- ** iconName #attr:iconName#
-- | An icon name that may be a base of a rendered icon.

#if defined(ENABLE_OVERLOADING)
    MarkAttributesIconNamePropertyInfo      ,
#endif
    constructMarkAttributesIconName         ,
    getMarkAttributesIconName               ,
#if defined(ENABLE_OVERLOADING)
    markAttributesIconName                  ,
#endif
    setMarkAttributesIconName               ,


-- ** pixbuf #attr:pixbuf#
-- | A t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' that may be a base of a rendered icon.

#if defined(ENABLE_OVERLOADING)
    MarkAttributesPixbufPropertyInfo        ,
#endif
    constructMarkAttributesPixbuf           ,
    getMarkAttributesPixbuf                 ,
#if defined(ENABLE_OVERLOADING)
    markAttributesPixbuf                    ,
#endif
    setMarkAttributesPixbuf                 ,


-- ** stockId #attr:stockId#
-- | A stock id that may be a base of a rendered icon.

#if defined(ENABLE_OVERLOADING)
    MarkAttributesStockIdPropertyInfo       ,
#endif
    constructMarkAttributesStockId          ,
    getMarkAttributesStockId                ,
#if defined(ENABLE_OVERLOADING)
    markAttributesStockId                   ,
#endif
    setMarkAttributesStockId                ,




 -- * Signals


-- ** queryTooltipMarkup #signal:queryTooltipMarkup#

    C_MarkAttributesQueryTooltipMarkupCallback,
    MarkAttributesQueryTooltipMarkupCallback,
#if defined(ENABLE_OVERLOADING)
    MarkAttributesQueryTooltipMarkupSignalInfo,
#endif
    afterMarkAttributesQueryTooltipMarkup   ,
    genClosure_MarkAttributesQueryTooltipMarkup,
    mk_MarkAttributesQueryTooltipMarkupCallback,
    noMarkAttributesQueryTooltipMarkupCallback,
    onMarkAttributesQueryTooltipMarkup      ,
    wrap_MarkAttributesQueryTooltipMarkupCallback,


-- ** queryTooltipText #signal:queryTooltipText#

    C_MarkAttributesQueryTooltipTextCallback,
    MarkAttributesQueryTooltipTextCallback  ,
#if defined(ENABLE_OVERLOADING)
    MarkAttributesQueryTooltipTextSignalInfo,
#endif
    afterMarkAttributesQueryTooltipText     ,
    genClosure_MarkAttributesQueryTooltipText,
    mk_MarkAttributesQueryTooltipTextCallback,
    noMarkAttributesQueryTooltipTextCallback,
    onMarkAttributesQueryTooltipText        ,
    wrap_MarkAttributesQueryTooltipTextCallback,




    ) 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.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.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Mark as GtkSource.Mark

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

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

foreign import ccall "gtk_source_mark_attributes_get_type"
    c_gtk_source_mark_attributes_get_type :: IO B.Types.GType

instance B.Types.TypedObject MarkAttributes where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_mark_attributes_get_type

instance B.Types.GObject MarkAttributes

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveMarkAttributesMethod (t :: Symbol) (o :: *) :: * where
    ResolveMarkAttributesMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMarkAttributesMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMarkAttributesMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMarkAttributesMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMarkAttributesMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMarkAttributesMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMarkAttributesMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMarkAttributesMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMarkAttributesMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMarkAttributesMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMarkAttributesMethod "renderIcon" o = MarkAttributesRenderIconMethodInfo
    ResolveMarkAttributesMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMarkAttributesMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMarkAttributesMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMarkAttributesMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMarkAttributesMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMarkAttributesMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMarkAttributesMethod "getBackground" o = MarkAttributesGetBackgroundMethodInfo
    ResolveMarkAttributesMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMarkAttributesMethod "getGicon" o = MarkAttributesGetGiconMethodInfo
    ResolveMarkAttributesMethod "getIconName" o = MarkAttributesGetIconNameMethodInfo
    ResolveMarkAttributesMethod "getPixbuf" o = MarkAttributesGetPixbufMethodInfo
    ResolveMarkAttributesMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMarkAttributesMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMarkAttributesMethod "getStockId" o = MarkAttributesGetStockIdMethodInfo
    ResolveMarkAttributesMethod "getTooltipMarkup" o = MarkAttributesGetTooltipMarkupMethodInfo
    ResolveMarkAttributesMethod "getTooltipText" o = MarkAttributesGetTooltipTextMethodInfo
    ResolveMarkAttributesMethod "setBackground" o = MarkAttributesSetBackgroundMethodInfo
    ResolveMarkAttributesMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMarkAttributesMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMarkAttributesMethod "setGicon" o = MarkAttributesSetGiconMethodInfo
    ResolveMarkAttributesMethod "setIconName" o = MarkAttributesSetIconNameMethodInfo
    ResolveMarkAttributesMethod "setPixbuf" o = MarkAttributesSetPixbufMethodInfo
    ResolveMarkAttributesMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMarkAttributesMethod "setStockId" o = MarkAttributesSetStockIdMethodInfo
    ResolveMarkAttributesMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal MarkAttributes::query-tooltip-markup
-- | The code should connect to this signal to provide a tooltip for given
-- /@mark@/. The tooltip can contain a markup.
type MarkAttributesQueryTooltipMarkupCallback =
    GtkSource.Mark.Mark
    -- ^ /@mark@/: The t'GI.GtkSource.Objects.Mark.Mark'.
    -> IO T.Text
    -- ^ __Returns:__ A tooltip. The string should be freed with
    -- 'GI.GLib.Functions.free' when done with it.

-- | A convenience synonym for @`Nothing` :: `Maybe` `MarkAttributesQueryTooltipMarkupCallback`@.
noMarkAttributesQueryTooltipMarkupCallback :: Maybe MarkAttributesQueryTooltipMarkupCallback
noMarkAttributesQueryTooltipMarkupCallback :: Maybe MarkAttributesQueryTooltipMarkupCallback
noMarkAttributesQueryTooltipMarkupCallback = Maybe MarkAttributesQueryTooltipMarkupCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_MarkAttributesQueryTooltipMarkupCallback =
    Ptr () ->                               -- object
    Ptr GtkSource.Mark.Mark ->
    Ptr () ->                               -- user_data
    IO CString

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

-- | Wrap the callback into a `GClosure`.
genClosure_MarkAttributesQueryTooltipMarkup :: MonadIO m => MarkAttributesQueryTooltipMarkupCallback -> m (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
genClosure_MarkAttributesQueryTooltipMarkup :: forall (m :: * -> *).
MonadIO m =>
MarkAttributesQueryTooltipMarkupCallback
-> m (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
genClosure_MarkAttributesQueryTooltipMarkup MarkAttributesQueryTooltipMarkupCallback
cb = IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
-> m (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
 -> m (GClosure C_MarkAttributesQueryTooltipMarkupCallback))
-> IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
-> m (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MarkAttributesQueryTooltipMarkupCallback
cb' = MarkAttributesQueryTooltipMarkupCallback
-> C_MarkAttributesQueryTooltipMarkupCallback
wrap_MarkAttributesQueryTooltipMarkupCallback MarkAttributesQueryTooltipMarkupCallback
cb
    C_MarkAttributesQueryTooltipMarkupCallback
-> IO (FunPtr C_MarkAttributesQueryTooltipMarkupCallback)
mk_MarkAttributesQueryTooltipMarkupCallback C_MarkAttributesQueryTooltipMarkupCallback
cb' IO (FunPtr C_MarkAttributesQueryTooltipMarkupCallback)
-> (FunPtr C_MarkAttributesQueryTooltipMarkupCallback
    -> IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback))
-> IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_MarkAttributesQueryTooltipMarkupCallback
-> IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `MarkAttributesQueryTooltipMarkupCallback` into a `C_MarkAttributesQueryTooltipMarkupCallback`.
wrap_MarkAttributesQueryTooltipMarkupCallback ::
    MarkAttributesQueryTooltipMarkupCallback ->
    C_MarkAttributesQueryTooltipMarkupCallback
wrap_MarkAttributesQueryTooltipMarkupCallback :: MarkAttributesQueryTooltipMarkupCallback
-> C_MarkAttributesQueryTooltipMarkupCallback
wrap_MarkAttributesQueryTooltipMarkupCallback MarkAttributesQueryTooltipMarkupCallback
_cb Ptr ()
_ Ptr Mark
mark Ptr ()
_ = do
    Mark
mark' <- ((ManagedPtr Mark -> Mark) -> Ptr Mark -> IO Mark
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Mark -> Mark
GtkSource.Mark.Mark) Ptr Mark
mark
    Text
result <- MarkAttributesQueryTooltipMarkupCallback
_cb  Mark
mark'
    CString
result' <- Text -> IO CString
textToCString Text
result
    CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
result'


-- | Connect a signal handler for the [queryTooltipMarkup](#signal:queryTooltipMarkup) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' markAttributes #queryTooltipMarkup callback
-- @
-- 
-- 
onMarkAttributesQueryTooltipMarkup :: (IsMarkAttributes a, MonadIO m) => a -> MarkAttributesQueryTooltipMarkupCallback -> m SignalHandlerId
onMarkAttributesQueryTooltipMarkup :: forall a (m :: * -> *).
(IsMarkAttributes a, MonadIO m) =>
a -> MarkAttributesQueryTooltipMarkupCallback -> m SignalHandlerId
onMarkAttributesQueryTooltipMarkup a
obj MarkAttributesQueryTooltipMarkupCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MarkAttributesQueryTooltipMarkupCallback
cb' = MarkAttributesQueryTooltipMarkupCallback
-> C_MarkAttributesQueryTooltipMarkupCallback
wrap_MarkAttributesQueryTooltipMarkupCallback MarkAttributesQueryTooltipMarkupCallback
cb
    FunPtr C_MarkAttributesQueryTooltipMarkupCallback
cb'' <- C_MarkAttributesQueryTooltipMarkupCallback
-> IO (FunPtr C_MarkAttributesQueryTooltipMarkupCallback)
mk_MarkAttributesQueryTooltipMarkupCallback C_MarkAttributesQueryTooltipMarkupCallback
cb'
    a
-> Text
-> FunPtr C_MarkAttributesQueryTooltipMarkupCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"query-tooltip-markup" FunPtr C_MarkAttributesQueryTooltipMarkupCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [queryTooltipMarkup](#signal:queryTooltipMarkup) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' markAttributes #queryTooltipMarkup callback
-- @
-- 
-- 
afterMarkAttributesQueryTooltipMarkup :: (IsMarkAttributes a, MonadIO m) => a -> MarkAttributesQueryTooltipMarkupCallback -> m SignalHandlerId
afterMarkAttributesQueryTooltipMarkup :: forall a (m :: * -> *).
(IsMarkAttributes a, MonadIO m) =>
a -> MarkAttributesQueryTooltipMarkupCallback -> m SignalHandlerId
afterMarkAttributesQueryTooltipMarkup a
obj MarkAttributesQueryTooltipMarkupCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MarkAttributesQueryTooltipMarkupCallback
cb' = MarkAttributesQueryTooltipMarkupCallback
-> C_MarkAttributesQueryTooltipMarkupCallback
wrap_MarkAttributesQueryTooltipMarkupCallback MarkAttributesQueryTooltipMarkupCallback
cb
    FunPtr C_MarkAttributesQueryTooltipMarkupCallback
cb'' <- C_MarkAttributesQueryTooltipMarkupCallback
-> IO (FunPtr C_MarkAttributesQueryTooltipMarkupCallback)
mk_MarkAttributesQueryTooltipMarkupCallback C_MarkAttributesQueryTooltipMarkupCallback
cb'
    a
-> Text
-> FunPtr C_MarkAttributesQueryTooltipMarkupCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"query-tooltip-markup" FunPtr C_MarkAttributesQueryTooltipMarkupCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MarkAttributesQueryTooltipMarkupSignalInfo
instance SignalInfo MarkAttributesQueryTooltipMarkupSignalInfo where
    type HaskellCallbackType MarkAttributesQueryTooltipMarkupSignalInfo = MarkAttributesQueryTooltipMarkupCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MarkAttributesQueryTooltipMarkupCallback cb
        cb'' <- mk_MarkAttributesQueryTooltipMarkupCallback cb'
        connectSignalFunPtr obj "query-tooltip-markup" cb'' connectMode detail

#endif

-- signal MarkAttributes::query-tooltip-text
-- | The code should connect to this signal to provide a tooltip for given
-- /@mark@/. The tooltip should be just a plain text.
type MarkAttributesQueryTooltipTextCallback =
    GtkSource.Mark.Mark
    -- ^ /@mark@/: The t'GI.GtkSource.Objects.Mark.Mark'.
    -> IO T.Text
    -- ^ __Returns:__ A tooltip. The string should be freed with
    -- 'GI.GLib.Functions.free' when done with it.

-- | A convenience synonym for @`Nothing` :: `Maybe` `MarkAttributesQueryTooltipTextCallback`@.
noMarkAttributesQueryTooltipTextCallback :: Maybe MarkAttributesQueryTooltipTextCallback
noMarkAttributesQueryTooltipTextCallback :: Maybe MarkAttributesQueryTooltipMarkupCallback
noMarkAttributesQueryTooltipTextCallback = Maybe MarkAttributesQueryTooltipMarkupCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_MarkAttributesQueryTooltipTextCallback =
    Ptr () ->                               -- object
    Ptr GtkSource.Mark.Mark ->
    Ptr () ->                               -- user_data
    IO CString

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

-- | Wrap the callback into a `GClosure`.
genClosure_MarkAttributesQueryTooltipText :: MonadIO m => MarkAttributesQueryTooltipTextCallback -> m (GClosure C_MarkAttributesQueryTooltipTextCallback)
genClosure_MarkAttributesQueryTooltipText :: forall (m :: * -> *).
MonadIO m =>
MarkAttributesQueryTooltipMarkupCallback
-> m (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
genClosure_MarkAttributesQueryTooltipText MarkAttributesQueryTooltipMarkupCallback
cb = IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
-> m (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
 -> m (GClosure C_MarkAttributesQueryTooltipMarkupCallback))
-> IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
-> m (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MarkAttributesQueryTooltipMarkupCallback
cb' = MarkAttributesQueryTooltipMarkupCallback
-> C_MarkAttributesQueryTooltipMarkupCallback
wrap_MarkAttributesQueryTooltipTextCallback MarkAttributesQueryTooltipMarkupCallback
cb
    C_MarkAttributesQueryTooltipMarkupCallback
-> IO (FunPtr C_MarkAttributesQueryTooltipMarkupCallback)
mk_MarkAttributesQueryTooltipTextCallback C_MarkAttributesQueryTooltipMarkupCallback
cb' IO (FunPtr C_MarkAttributesQueryTooltipMarkupCallback)
-> (FunPtr C_MarkAttributesQueryTooltipMarkupCallback
    -> IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback))
-> IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_MarkAttributesQueryTooltipMarkupCallback
-> IO (GClosure C_MarkAttributesQueryTooltipMarkupCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `MarkAttributesQueryTooltipTextCallback` into a `C_MarkAttributesQueryTooltipTextCallback`.
wrap_MarkAttributesQueryTooltipTextCallback ::
    MarkAttributesQueryTooltipTextCallback ->
    C_MarkAttributesQueryTooltipTextCallback
wrap_MarkAttributesQueryTooltipTextCallback :: MarkAttributesQueryTooltipMarkupCallback
-> C_MarkAttributesQueryTooltipMarkupCallback
wrap_MarkAttributesQueryTooltipTextCallback MarkAttributesQueryTooltipMarkupCallback
_cb Ptr ()
_ Ptr Mark
mark Ptr ()
_ = do
    Mark
mark' <- ((ManagedPtr Mark -> Mark) -> Ptr Mark -> IO Mark
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Mark -> Mark
GtkSource.Mark.Mark) Ptr Mark
mark
    Text
result <- MarkAttributesQueryTooltipMarkupCallback
_cb  Mark
mark'
    CString
result' <- Text -> IO CString
textToCString Text
result
    CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
result'


-- | Connect a signal handler for the [queryTooltipText](#signal:queryTooltipText) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' markAttributes #queryTooltipText callback
-- @
-- 
-- 
onMarkAttributesQueryTooltipText :: (IsMarkAttributes a, MonadIO m) => a -> MarkAttributesQueryTooltipTextCallback -> m SignalHandlerId
onMarkAttributesQueryTooltipText :: forall a (m :: * -> *).
(IsMarkAttributes a, MonadIO m) =>
a -> MarkAttributesQueryTooltipMarkupCallback -> m SignalHandlerId
onMarkAttributesQueryTooltipText a
obj MarkAttributesQueryTooltipMarkupCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MarkAttributesQueryTooltipMarkupCallback
cb' = MarkAttributesQueryTooltipMarkupCallback
-> C_MarkAttributesQueryTooltipMarkupCallback
wrap_MarkAttributesQueryTooltipTextCallback MarkAttributesQueryTooltipMarkupCallback
cb
    FunPtr C_MarkAttributesQueryTooltipMarkupCallback
cb'' <- C_MarkAttributesQueryTooltipMarkupCallback
-> IO (FunPtr C_MarkAttributesQueryTooltipMarkupCallback)
mk_MarkAttributesQueryTooltipTextCallback C_MarkAttributesQueryTooltipMarkupCallback
cb'
    a
-> Text
-> FunPtr C_MarkAttributesQueryTooltipMarkupCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"query-tooltip-text" FunPtr C_MarkAttributesQueryTooltipMarkupCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [queryTooltipText](#signal:queryTooltipText) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' markAttributes #queryTooltipText callback
-- @
-- 
-- 
afterMarkAttributesQueryTooltipText :: (IsMarkAttributes a, MonadIO m) => a -> MarkAttributesQueryTooltipTextCallback -> m SignalHandlerId
afterMarkAttributesQueryTooltipText :: forall a (m :: * -> *).
(IsMarkAttributes a, MonadIO m) =>
a -> MarkAttributesQueryTooltipMarkupCallback -> m SignalHandlerId
afterMarkAttributesQueryTooltipText a
obj MarkAttributesQueryTooltipMarkupCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MarkAttributesQueryTooltipMarkupCallback
cb' = MarkAttributesQueryTooltipMarkupCallback
-> C_MarkAttributesQueryTooltipMarkupCallback
wrap_MarkAttributesQueryTooltipTextCallback MarkAttributesQueryTooltipMarkupCallback
cb
    FunPtr C_MarkAttributesQueryTooltipMarkupCallback
cb'' <- C_MarkAttributesQueryTooltipMarkupCallback
-> IO (FunPtr C_MarkAttributesQueryTooltipMarkupCallback)
mk_MarkAttributesQueryTooltipTextCallback C_MarkAttributesQueryTooltipMarkupCallback
cb'
    a
-> Text
-> FunPtr C_MarkAttributesQueryTooltipMarkupCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"query-tooltip-text" FunPtr C_MarkAttributesQueryTooltipMarkupCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MarkAttributesQueryTooltipTextSignalInfo
instance SignalInfo MarkAttributesQueryTooltipTextSignalInfo where
    type HaskellCallbackType MarkAttributesQueryTooltipTextSignalInfo = MarkAttributesQueryTooltipTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MarkAttributesQueryTooltipTextCallback cb
        cb'' <- mk_MarkAttributesQueryTooltipTextCallback cb'
        connectSignalFunPtr obj "query-tooltip-text" cb'' connectMode detail

#endif

-- VVV Prop "background"
   -- Type: TInterface (Name {namespace = "Gdk", name = "RGBA"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@background@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' markAttributes #background
-- @
getMarkAttributesBackground :: (MonadIO m, IsMarkAttributes o) => o -> m (Maybe Gdk.RGBA.RGBA)
getMarkAttributesBackground :: forall (m :: * -> *) o.
(MonadIO m, IsMarkAttributes o) =>
o -> m (Maybe RGBA)
getMarkAttributesBackground o
obj = IO (Maybe RGBA) -> m (Maybe RGBA)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe RGBA) -> m (Maybe RGBA))
-> IO (Maybe RGBA) -> m (Maybe RGBA)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr RGBA -> RGBA) -> IO (Maybe RGBA)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"background" ManagedPtr RGBA -> RGBA
Gdk.RGBA.RGBA

-- | Set the value of the “@background@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' markAttributes [ #background 'Data.GI.Base.Attributes.:=' value ]
-- @
setMarkAttributesBackground :: (MonadIO m, IsMarkAttributes o) => o -> Gdk.RGBA.RGBA -> m ()
setMarkAttributesBackground :: forall (m :: * -> *) o.
(MonadIO m, IsMarkAttributes o) =>
o -> RGBA -> m ()
setMarkAttributesBackground o
obj RGBA
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe RGBA -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"background" (RGBA -> Maybe RGBA
forall a. a -> Maybe a
Just RGBA
val)

-- | Construct a `GValueConstruct` with valid value for the “@background@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMarkAttributesBackground :: (IsMarkAttributes o, MIO.MonadIO m) => Gdk.RGBA.RGBA -> m (GValueConstruct o)
constructMarkAttributesBackground :: forall o (m :: * -> *).
(IsMarkAttributes o, MonadIO m) =>
RGBA -> m (GValueConstruct o)
constructMarkAttributesBackground RGBA
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe RGBA -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"background" (RGBA -> Maybe RGBA
forall a. a -> Maybe a
P.Just RGBA
val)

#if defined(ENABLE_OVERLOADING)
data MarkAttributesBackgroundPropertyInfo
instance AttrInfo MarkAttributesBackgroundPropertyInfo where
    type AttrAllowedOps MarkAttributesBackgroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MarkAttributesBackgroundPropertyInfo = IsMarkAttributes
    type AttrSetTypeConstraint MarkAttributesBackgroundPropertyInfo = (~) Gdk.RGBA.RGBA
    type AttrTransferTypeConstraint MarkAttributesBackgroundPropertyInfo = (~) Gdk.RGBA.RGBA
    type AttrTransferType MarkAttributesBackgroundPropertyInfo = Gdk.RGBA.RGBA
    type AttrGetType MarkAttributesBackgroundPropertyInfo = (Maybe Gdk.RGBA.RGBA)
    type AttrLabel MarkAttributesBackgroundPropertyInfo = "background"
    type AttrOrigin MarkAttributesBackgroundPropertyInfo = MarkAttributes
    attrGet = getMarkAttributesBackground
    attrSet = setMarkAttributesBackground
    attrTransfer _ v = do
        return v
    attrConstruct = constructMarkAttributesBackground
    attrClear = undefined
#endif

-- VVV Prop "gicon"
   -- Type: TInterface (Name {namespace = "Gio", name = "Icon"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

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

#if defined(ENABLE_OVERLOADING)
data MarkAttributesGiconPropertyInfo
instance AttrInfo MarkAttributesGiconPropertyInfo where
    type AttrAllowedOps MarkAttributesGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MarkAttributesGiconPropertyInfo = IsMarkAttributes
    type AttrSetTypeConstraint MarkAttributesGiconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferTypeConstraint MarkAttributesGiconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferType MarkAttributesGiconPropertyInfo = Gio.Icon.Icon
    type AttrGetType MarkAttributesGiconPropertyInfo = Gio.Icon.Icon
    type AttrLabel MarkAttributesGiconPropertyInfo = "gicon"
    type AttrOrigin MarkAttributesGiconPropertyInfo = MarkAttributes
    attrGet = getMarkAttributesGicon
    attrSet = setMarkAttributesGicon
    attrTransfer _ v = do
        unsafeCastTo Gio.Icon.Icon v
    attrConstruct = constructMarkAttributesGicon
    attrClear = undefined
#endif

-- VVV Prop "icon-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' markAttributes #iconName
-- @
getMarkAttributesIconName :: (MonadIO m, IsMarkAttributes o) => o -> m T.Text
getMarkAttributesIconName :: forall (m :: * -> *) o.
(MonadIO m, IsMarkAttributes o) =>
o -> m Text
getMarkAttributesIconName o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getMarkAttributesIconName" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"icon-name"

-- | Set the value of the “@icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' markAttributes [ #iconName 'Data.GI.Base.Attributes.:=' value ]
-- @
setMarkAttributesIconName :: (MonadIO m, IsMarkAttributes o) => o -> T.Text -> m ()
setMarkAttributesIconName :: forall (m :: * -> *) o.
(MonadIO m, IsMarkAttributes o) =>
o -> Text -> m ()
setMarkAttributesIconName o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@icon-name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMarkAttributesIconName :: (IsMarkAttributes o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructMarkAttributesIconName :: forall o (m :: * -> *).
(IsMarkAttributes o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructMarkAttributesIconName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data MarkAttributesIconNamePropertyInfo
instance AttrInfo MarkAttributesIconNamePropertyInfo where
    type AttrAllowedOps MarkAttributesIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MarkAttributesIconNamePropertyInfo = IsMarkAttributes
    type AttrSetTypeConstraint MarkAttributesIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint MarkAttributesIconNamePropertyInfo = (~) T.Text
    type AttrTransferType MarkAttributesIconNamePropertyInfo = T.Text
    type AttrGetType MarkAttributesIconNamePropertyInfo = T.Text
    type AttrLabel MarkAttributesIconNamePropertyInfo = "icon-name"
    type AttrOrigin MarkAttributesIconNamePropertyInfo = MarkAttributes
    attrGet = getMarkAttributesIconName
    attrSet = setMarkAttributesIconName
    attrTransfer _ v = do
        return v
    attrConstruct = constructMarkAttributesIconName
    attrClear = undefined
#endif

-- VVV Prop "pixbuf"
   -- Type: TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

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

#if defined(ENABLE_OVERLOADING)
data MarkAttributesPixbufPropertyInfo
instance AttrInfo MarkAttributesPixbufPropertyInfo where
    type AttrAllowedOps MarkAttributesPixbufPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MarkAttributesPixbufPropertyInfo = IsMarkAttributes
    type AttrSetTypeConstraint MarkAttributesPixbufPropertyInfo = GdkPixbuf.Pixbuf.IsPixbuf
    type AttrTransferTypeConstraint MarkAttributesPixbufPropertyInfo = GdkPixbuf.Pixbuf.IsPixbuf
    type AttrTransferType MarkAttributesPixbufPropertyInfo = GdkPixbuf.Pixbuf.Pixbuf
    type AttrGetType MarkAttributesPixbufPropertyInfo = GdkPixbuf.Pixbuf.Pixbuf
    type AttrLabel MarkAttributesPixbufPropertyInfo = "pixbuf"
    type AttrOrigin MarkAttributesPixbufPropertyInfo = MarkAttributes
    attrGet = getMarkAttributesPixbuf
    attrSet = setMarkAttributesPixbuf
    attrTransfer _ v = do
        unsafeCastTo GdkPixbuf.Pixbuf.Pixbuf v
    attrConstruct = constructMarkAttributesPixbuf
    attrClear = undefined
#endif

-- VVV Prop "stock-id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@stock-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' markAttributes #stockId
-- @
getMarkAttributesStockId :: (MonadIO m, IsMarkAttributes o) => o -> m T.Text
getMarkAttributesStockId :: forall (m :: * -> *) o.
(MonadIO m, IsMarkAttributes o) =>
o -> m Text
getMarkAttributesStockId o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getMarkAttributesStockId" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"stock-id"

-- | Set the value of the “@stock-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' markAttributes [ #stockId 'Data.GI.Base.Attributes.:=' value ]
-- @
setMarkAttributesStockId :: (MonadIO m, IsMarkAttributes o) => o -> T.Text -> m ()
setMarkAttributesStockId :: forall (m :: * -> *) o.
(MonadIO m, IsMarkAttributes o) =>
o -> Text -> m ()
setMarkAttributesStockId o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"stock-id" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@stock-id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMarkAttributesStockId :: (IsMarkAttributes o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructMarkAttributesStockId :: forall o (m :: * -> *).
(IsMarkAttributes o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructMarkAttributesStockId Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"stock-id" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data MarkAttributesStockIdPropertyInfo
instance AttrInfo MarkAttributesStockIdPropertyInfo where
    type AttrAllowedOps MarkAttributesStockIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MarkAttributesStockIdPropertyInfo = IsMarkAttributes
    type AttrSetTypeConstraint MarkAttributesStockIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint MarkAttributesStockIdPropertyInfo = (~) T.Text
    type AttrTransferType MarkAttributesStockIdPropertyInfo = T.Text
    type AttrGetType MarkAttributesStockIdPropertyInfo = T.Text
    type AttrLabel MarkAttributesStockIdPropertyInfo = "stock-id"
    type AttrOrigin MarkAttributesStockIdPropertyInfo = MarkAttributes
    attrGet = getMarkAttributesStockId
    attrSet = setMarkAttributesStockId
    attrTransfer _ v = do
        return v
    attrConstruct = constructMarkAttributesStockId
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MarkAttributes
type instance O.AttributeList MarkAttributes = MarkAttributesAttributeList
type MarkAttributesAttributeList = ('[ '("background", MarkAttributesBackgroundPropertyInfo), '("gicon", MarkAttributesGiconPropertyInfo), '("iconName", MarkAttributesIconNamePropertyInfo), '("pixbuf", MarkAttributesPixbufPropertyInfo), '("stockId", MarkAttributesStockIdPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
markAttributesBackground :: AttrLabelProxy "background"
markAttributesBackground = AttrLabelProxy

markAttributesGicon :: AttrLabelProxy "gicon"
markAttributesGicon = AttrLabelProxy

markAttributesIconName :: AttrLabelProxy "iconName"
markAttributesIconName = AttrLabelProxy

markAttributesPixbuf :: AttrLabelProxy "pixbuf"
markAttributesPixbuf = AttrLabelProxy

markAttributesStockId :: AttrLabelProxy "stockId"
markAttributesStockId = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList MarkAttributes = MarkAttributesSignalList
type MarkAttributesSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltipMarkup", MarkAttributesQueryTooltipMarkupSignalInfo), '("queryTooltipText", MarkAttributesQueryTooltipTextSignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_source_mark_attributes_new" gtk_source_mark_attributes_new :: 
    IO (Ptr MarkAttributes)

-- | Creates a new source mark attributes.
markAttributesNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m MarkAttributes
    -- ^ __Returns:__ a new source mark attributes.
markAttributesNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m MarkAttributes
markAttributesNew  = IO MarkAttributes -> m MarkAttributes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MarkAttributes -> m MarkAttributes)
-> IO MarkAttributes -> m MarkAttributes
forall a b. (a -> b) -> a -> b
$ do
    Ptr MarkAttributes
result <- IO (Ptr MarkAttributes)
gtk_source_mark_attributes_new
    Text -> Ptr MarkAttributes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"markAttributesNew" Ptr MarkAttributes
result
    MarkAttributes
result' <- ((ManagedPtr MarkAttributes -> MarkAttributes)
-> Ptr MarkAttributes -> IO MarkAttributes
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr MarkAttributes -> MarkAttributes
MarkAttributes) Ptr MarkAttributes
result
    MarkAttributes -> IO MarkAttributes
forall (m :: * -> *) a. Monad m => a -> m a
return MarkAttributes
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method MarkAttributes::get_background
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "background"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkRGBA." , 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_mark_attributes_get_background" gtk_source_mark_attributes_get_background :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    Ptr Gdk.RGBA.RGBA ->                    -- background : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO CInt

-- | Stores background color in /@background@/.
markAttributesGetBackground ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> m ((Bool, Gdk.RGBA.RGBA))
    -- ^ __Returns:__ whether background color for /@attributes@/ was set.
markAttributesGetBackground :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMarkAttributes a) =>
a -> m (Bool, RGBA)
markAttributesGetBackground a
attributes = IO (Bool, RGBA) -> m (Bool, RGBA)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, RGBA) -> m (Bool, RGBA))
-> IO (Bool, RGBA) -> m (Bool, RGBA)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    Ptr RGBA
background <- Int -> IO (Ptr RGBA)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Gdk.RGBA.RGBA)
    CInt
result <- Ptr MarkAttributes -> Ptr RGBA -> IO CInt
gtk_source_mark_attributes_get_background Ptr MarkAttributes
attributes' Ptr RGBA
background
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    RGBA
background' <- ((ManagedPtr RGBA -> RGBA) -> Ptr RGBA -> IO RGBA
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RGBA -> RGBA
Gdk.RGBA.RGBA) Ptr RGBA
background
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    (Bool, RGBA) -> IO (Bool, RGBA)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', RGBA
background')

#if defined(ENABLE_OVERLOADING)
data MarkAttributesGetBackgroundMethodInfo
instance (signature ~ (m ((Bool, Gdk.RGBA.RGBA))), MonadIO m, IsMarkAttributes a) => O.OverloadedMethod MarkAttributesGetBackgroundMethodInfo a signature where
    overloadedMethod = markAttributesGetBackground

instance O.OverloadedMethodInfo MarkAttributesGetBackgroundMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesGetBackground",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesGetBackground"
        }


#endif

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

foreign import ccall "gtk_source_mark_attributes_get_gicon" gtk_source_mark_attributes_get_gicon :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets a t'GI.Gio.Interfaces.Icon.Icon' to be used as a base for rendered icon. Note that the icon can
-- be 'P.Nothing' if it wasn\'t set earlier.
markAttributesGetGicon ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> m Gio.Icon.Icon
    -- ^ __Returns:__ An icon. The icon belongs to /@attributes@/ and should
    -- not be unreffed.
markAttributesGetGicon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMarkAttributes a) =>
a -> m Icon
markAttributesGetGicon a
attributes = IO Icon -> m Icon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Icon -> m Icon) -> IO Icon -> m Icon
forall a b. (a -> b) -> a -> b
$ do
    Ptr MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    Ptr Icon
result <- Ptr MarkAttributes -> IO (Ptr Icon)
gtk_source_mark_attributes_get_gicon Ptr MarkAttributes
attributes'
    Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"markAttributesGetGicon" Ptr Icon
result
    Icon
result' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'

#if defined(ENABLE_OVERLOADING)
data MarkAttributesGetGiconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m, IsMarkAttributes a) => O.OverloadedMethod MarkAttributesGetGiconMethodInfo a signature where
    overloadedMethod = markAttributesGetGicon

instance O.OverloadedMethodInfo MarkAttributesGetGiconMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesGetGicon",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesGetGicon"
        }


#endif

-- method MarkAttributes::get_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , 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_mark_attributes_get_icon_name" gtk_source_mark_attributes_get_icon_name :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    IO CString

-- | Gets a name of an icon to be used as a base for rendered icon. Note that the
-- icon name can be 'P.Nothing' if it wasn\'t set earlier.
markAttributesGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> m T.Text
    -- ^ __Returns:__ An icon name. The string belongs to /@attributes@/ and
    -- should not be freed.
markAttributesGetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMarkAttributes a) =>
a -> m Text
markAttributesGetIconName a
attributes = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    CString
result <- Ptr MarkAttributes -> IO CString
gtk_source_mark_attributes_get_icon_name Ptr MarkAttributes
attributes'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"markAttributesGetIconName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MarkAttributesGetIconNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsMarkAttributes a) => O.OverloadedMethod MarkAttributesGetIconNameMethodInfo a signature where
    overloadedMethod = markAttributesGetIconName

instance O.OverloadedMethodInfo MarkAttributesGetIconNameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesGetIconName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesGetIconName"
        }


#endif

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

foreign import ccall "gtk_source_mark_attributes_get_pixbuf" gtk_source_mark_attributes_get_pixbuf :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Gets a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' to be used as a base for rendered icon. Note that the
-- pixbuf can be 'P.Nothing' if it wasn\'t set earlier.
markAttributesGetPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> m GdkPixbuf.Pixbuf.Pixbuf
    -- ^ __Returns:__ A pixbuf. The pixbuf belongs to /@attributes@/ and
    -- should not be unreffed.
markAttributesGetPixbuf :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMarkAttributes a) =>
a -> m Pixbuf
markAttributesGetPixbuf a
attributes = IO Pixbuf -> m Pixbuf
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pixbuf -> m Pixbuf) -> IO Pixbuf -> m Pixbuf
forall a b. (a -> b) -> a -> b
$ do
    Ptr MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    Ptr Pixbuf
result <- Ptr MarkAttributes -> IO (Ptr Pixbuf)
gtk_source_mark_attributes_get_pixbuf Ptr MarkAttributes
attributes'
    Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"markAttributesGetPixbuf" Ptr Pixbuf
result
    Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result'

#if defined(ENABLE_OVERLOADING)
data MarkAttributesGetPixbufMethodInfo
instance (signature ~ (m GdkPixbuf.Pixbuf.Pixbuf), MonadIO m, IsMarkAttributes a) => O.OverloadedMethod MarkAttributesGetPixbufMethodInfo a signature where
    overloadedMethod = markAttributesGetPixbuf

instance O.OverloadedMethodInfo MarkAttributesGetPixbufMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesGetPixbuf",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesGetPixbuf"
        }


#endif

-- method MarkAttributes::get_stock_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , 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_mark_attributes_get_stock_id" gtk_source_mark_attributes_get_stock_id :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    IO CString

{-# DEPRECATED markAttributesGetStockId ["(Since version 3.10)","Don\\'t use this function."] #-}
-- | Gets a stock id of an icon used by this attributes. Note that the stock id can
-- be 'P.Nothing' if it wasn\'t set earlier.
markAttributesGetStockId ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> m T.Text
    -- ^ __Returns:__ Stock id. Returned string is owned by /@attributes@/ and
    -- shouldn\'t be freed.
markAttributesGetStockId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMarkAttributes a) =>
a -> m Text
markAttributesGetStockId a
attributes = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    CString
result <- Ptr MarkAttributes -> IO CString
gtk_source_mark_attributes_get_stock_id Ptr MarkAttributes
attributes'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"markAttributesGetStockId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MarkAttributesGetStockIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsMarkAttributes a) => O.OverloadedMethod MarkAttributesGetStockIdMethodInfo a signature where
    overloadedMethod = markAttributesGetStockId

instance O.OverloadedMethodInfo MarkAttributesGetStockIdMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesGetStockId",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesGetStockId"
        }


#endif

-- method MarkAttributes::get_tooltip_markup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mark"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Mark" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMark." , 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_mark_attributes_get_tooltip_markup" gtk_source_mark_attributes_get_tooltip_markup :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    Ptr GtkSource.Mark.Mark ->              -- mark : TInterface (Name {namespace = "GtkSource", name = "Mark"})
    IO CString

-- | Queries for a tooltip by emitting
-- a [queryTooltipMarkup]("GI.GtkSource.Objects.MarkAttributes#g:signal:queryTooltipMarkup") signal. The tooltip may contain
-- a markup.
markAttributesGetTooltipMarkup ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a, GtkSource.Mark.IsMark b) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> b
    -- ^ /@mark@/: a t'GI.GtkSource.Objects.Mark.Mark'.
    -> m T.Text
    -- ^ __Returns:__ A tooltip. The returned string should be freed by
    -- using 'GI.GLib.Functions.free' when done with it.
markAttributesGetTooltipMarkup :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMarkAttributes a, IsMark b) =>
a -> b -> m Text
markAttributesGetTooltipMarkup a
attributes b
mark = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    Ptr Mark
mark' <- b -> IO (Ptr Mark)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
mark
    CString
result <- Ptr MarkAttributes -> Ptr Mark -> IO CString
gtk_source_mark_attributes_get_tooltip_markup Ptr MarkAttributes
attributes' Ptr Mark
mark'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"markAttributesGetTooltipMarkup" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
mark
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MarkAttributesGetTooltipMarkupMethodInfo
instance (signature ~ (b -> m T.Text), MonadIO m, IsMarkAttributes a, GtkSource.Mark.IsMark b) => O.OverloadedMethod MarkAttributesGetTooltipMarkupMethodInfo a signature where
    overloadedMethod = markAttributesGetTooltipMarkup

instance O.OverloadedMethodInfo MarkAttributesGetTooltipMarkupMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesGetTooltipMarkup",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesGetTooltipMarkup"
        }


#endif

-- method MarkAttributes::get_tooltip_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mark"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Mark" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMark." , 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_mark_attributes_get_tooltip_text" gtk_source_mark_attributes_get_tooltip_text :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    Ptr GtkSource.Mark.Mark ->              -- mark : TInterface (Name {namespace = "GtkSource", name = "Mark"})
    IO CString

-- | Queries for a tooltip by emitting
-- a [queryTooltipText]("GI.GtkSource.Objects.MarkAttributes#g:signal:queryTooltipText") signal. The tooltip is a plain
-- text.
markAttributesGetTooltipText ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a, GtkSource.Mark.IsMark b) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> b
    -- ^ /@mark@/: a t'GI.GtkSource.Objects.Mark.Mark'.
    -> m T.Text
    -- ^ __Returns:__ A tooltip. The returned string should be freed by
    -- using 'GI.GLib.Functions.free' when done with it.
markAttributesGetTooltipText :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMarkAttributes a, IsMark b) =>
a -> b -> m Text
markAttributesGetTooltipText a
attributes b
mark = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    Ptr Mark
mark' <- b -> IO (Ptr Mark)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
mark
    CString
result <- Ptr MarkAttributes -> Ptr Mark -> IO CString
gtk_source_mark_attributes_get_tooltip_text Ptr MarkAttributes
attributes' Ptr Mark
mark'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"markAttributesGetTooltipText" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
mark
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MarkAttributesGetTooltipTextMethodInfo
instance (signature ~ (b -> m T.Text), MonadIO m, IsMarkAttributes a, GtkSource.Mark.IsMark b) => O.OverloadedMethod MarkAttributesGetTooltipTextMethodInfo a signature where
    overloadedMethod = markAttributesGetTooltipText

instance O.OverloadedMethodInfo MarkAttributesGetTooltipTextMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesGetTooltipText",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesGetTooltipText"
        }


#endif

-- method MarkAttributes::render_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "widget of which style settings may be used."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "size of the rendered icon."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_mark_attributes_render_icon" gtk_source_mark_attributes_render_icon :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    Int32 ->                                -- size : TBasicType TInt
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Renders an icon of given size. The base of the icon is set by the last call
-- to one of: 'GI.GtkSource.Objects.MarkAttributes.markAttributesSetPixbuf',
-- 'GI.GtkSource.Objects.MarkAttributes.markAttributesSetGicon',
-- 'GI.GtkSource.Objects.MarkAttributes.markAttributesSetIconName' or
-- 'GI.GtkSource.Objects.MarkAttributes.markAttributesSetStockId'. /@size@/ cannot be lower than 1.
markAttributesRenderIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> b
    -- ^ /@widget@/: widget of which style settings may be used.
    -> Int32
    -- ^ /@size@/: size of the rendered icon.
    -> m GdkPixbuf.Pixbuf.Pixbuf
    -- ^ __Returns:__ A rendered pixbuf. The pixbuf belongs to /@attributes@/
    -- and should not be unreffed.
markAttributesRenderIcon :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMarkAttributes a, IsWidget b) =>
a -> b -> Int32 -> m Pixbuf
markAttributesRenderIcon a
attributes b
widget Int32
size = IO Pixbuf -> m Pixbuf
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pixbuf -> m Pixbuf) -> IO Pixbuf -> m Pixbuf
forall a b. (a -> b) -> a -> b
$ do
    Ptr MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    Ptr Pixbuf
result <- Ptr MarkAttributes -> Ptr Widget -> Int32 -> IO (Ptr Pixbuf)
gtk_source_mark_attributes_render_icon Ptr MarkAttributes
attributes' Ptr Widget
widget' Int32
size
    Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"markAttributesRenderIcon" Ptr Pixbuf
result
    Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result'

#if defined(ENABLE_OVERLOADING)
data MarkAttributesRenderIconMethodInfo
instance (signature ~ (b -> Int32 -> m GdkPixbuf.Pixbuf.Pixbuf), MonadIO m, IsMarkAttributes a, Gtk.Widget.IsWidget b) => O.OverloadedMethod MarkAttributesRenderIconMethodInfo a signature where
    overloadedMethod = markAttributesRenderIcon

instance O.OverloadedMethodInfo MarkAttributesRenderIconMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesRenderIcon",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesRenderIcon"
        }


#endif

-- method MarkAttributes::set_background
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "background"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkRGBA." , 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_mark_attributes_set_background" gtk_source_mark_attributes_set_background :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    Ptr Gdk.RGBA.RGBA ->                    -- background : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO ()

-- | Sets background color to the one given in /@background@/.
markAttributesSetBackground ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> Gdk.RGBA.RGBA
    -- ^ /@background@/: a t'GI.Gdk.Structs.RGBA.RGBA'.
    -> m ()
markAttributesSetBackground :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMarkAttributes a) =>
a -> RGBA -> m ()
markAttributesSetBackground a
attributes RGBA
background = 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 MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    Ptr RGBA
background' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
background
    Ptr MarkAttributes -> Ptr RGBA -> IO ()
gtk_source_mark_attributes_set_background Ptr MarkAttributes
attributes' Ptr RGBA
background'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
background
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MarkAttributesSetBackgroundMethodInfo
instance (signature ~ (Gdk.RGBA.RGBA -> m ()), MonadIO m, IsMarkAttributes a) => O.OverloadedMethod MarkAttributesSetBackgroundMethodInfo a signature where
    overloadedMethod = markAttributesSetBackground

instance O.OverloadedMethodInfo MarkAttributesSetBackgroundMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesSetBackground",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesSetBackground"
        }


#endif

-- method MarkAttributes::set_gicon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gicon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIcon to be used."
--                 , 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_mark_attributes_set_gicon" gtk_source_mark_attributes_set_gicon :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    Ptr Gio.Icon.Icon ->                    -- gicon : TInterface (Name {namespace = "Gio", name = "Icon"})
    IO ()

-- | Sets an icon to be used as a base for rendered icon.
markAttributesSetGicon ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a, Gio.Icon.IsIcon b) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> b
    -- ^ /@gicon@/: a t'GI.Gio.Interfaces.Icon.Icon' to be used.
    -> m ()
markAttributesSetGicon :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMarkAttributes a, IsIcon b) =>
a -> b -> m ()
markAttributesSetGicon a
attributes b
gicon = 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 MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    Ptr Icon
gicon' <- b -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
gicon
    Ptr MarkAttributes -> Ptr Icon -> IO ()
gtk_source_mark_attributes_set_gicon Ptr MarkAttributes
attributes' Ptr Icon
gicon'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
gicon
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MarkAttributesSetGiconMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMarkAttributes a, Gio.Icon.IsIcon b) => O.OverloadedMethod MarkAttributesSetGiconMethodInfo a signature where
    overloadedMethod = markAttributesSetGicon

instance O.OverloadedMethodInfo MarkAttributesSetGiconMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesSetGicon",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesSetGicon"
        }


#endif

-- method MarkAttributes::set_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of an icon to be used."
--                 , 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_mark_attributes_set_icon_name" gtk_source_mark_attributes_set_icon_name :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    CString ->                              -- icon_name : TBasicType TUTF8
    IO ()

-- | Sets a name of an icon to be used as a base for rendered icon.
markAttributesSetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> T.Text
    -- ^ /@iconName@/: name of an icon to be used.
    -> m ()
markAttributesSetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMarkAttributes a) =>
a -> Text -> m ()
markAttributesSetIconName a
attributes Text
iconName = 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 MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    Ptr MarkAttributes -> CString -> IO ()
gtk_source_mark_attributes_set_icon_name Ptr MarkAttributes
attributes' CString
iconName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MarkAttributesSetIconNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsMarkAttributes a) => O.OverloadedMethod MarkAttributesSetIconNameMethodInfo a signature where
    overloadedMethod = markAttributesSetIconName

instance O.OverloadedMethodInfo MarkAttributesSetIconNameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesSetIconName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesSetIconName"
        }


#endif

-- method MarkAttributes::set_pixbuf
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixbuf"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbuf to be used."
--                 , 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_mark_attributes_set_pixbuf" gtk_source_mark_attributes_set_pixbuf :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- pixbuf : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO ()

-- | Sets a pixbuf to be used as a base for rendered icon.
markAttributesSetPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a, GdkPixbuf.Pixbuf.IsPixbuf b) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> b
    -- ^ /@pixbuf@/: a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' to be used.
    -> m ()
markAttributesSetPixbuf :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMarkAttributes a, IsPixbuf b) =>
a -> b -> m ()
markAttributesSetPixbuf a
attributes b
pixbuf = 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 MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    Ptr Pixbuf
pixbuf' <- b -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pixbuf
    Ptr MarkAttributes -> Ptr Pixbuf -> IO ()
gtk_source_mark_attributes_set_pixbuf Ptr MarkAttributes
attributes' Ptr Pixbuf
pixbuf'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pixbuf
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MarkAttributesSetPixbufMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMarkAttributes a, GdkPixbuf.Pixbuf.IsPixbuf b) => O.OverloadedMethod MarkAttributesSetPixbufMethodInfo a signature where
    overloadedMethod = markAttributesSetPixbuf

instance O.OverloadedMethodInfo MarkAttributesSetPixbufMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesSetPixbuf",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesSetPixbuf"
        }


#endif

-- method MarkAttributes::set_stock_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attributes"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "MarkAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceMarkAttributes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stock_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a stock id." , 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_mark_attributes_set_stock_id" gtk_source_mark_attributes_set_stock_id :: 
    Ptr MarkAttributes ->                   -- attributes : TInterface (Name {namespace = "GtkSource", name = "MarkAttributes"})
    CString ->                              -- stock_id : TBasicType TUTF8
    IO ()

{-# DEPRECATED markAttributesSetStockId ["(Since version 3.10)","Don\\'t use this function."] #-}
-- | Sets stock id to be used as a base for rendered icon.
markAttributesSetStockId ::
    (B.CallStack.HasCallStack, MonadIO m, IsMarkAttributes a) =>
    a
    -- ^ /@attributes@/: a t'GI.GtkSource.Objects.MarkAttributes.MarkAttributes'.
    -> T.Text
    -- ^ /@stockId@/: a stock id.
    -> m ()
markAttributesSetStockId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMarkAttributes a) =>
a -> Text -> m ()
markAttributesSetStockId a
attributes Text
stockId = 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 MarkAttributes
attributes' <- a -> IO (Ptr MarkAttributes)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attributes
    CString
stockId' <- Text -> IO CString
textToCString Text
stockId
    Ptr MarkAttributes -> CString -> IO ()
gtk_source_mark_attributes_set_stock_id Ptr MarkAttributes
attributes' CString
stockId'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attributes
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stockId'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MarkAttributesSetStockIdMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsMarkAttributes a) => O.OverloadedMethod MarkAttributesSetStockIdMethodInfo a signature where
    overloadedMethod = markAttributesSetStockId

instance O.OverloadedMethodInfo MarkAttributesSetStockIdMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.MarkAttributes.markAttributesSetStockId",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-MarkAttributes.html#v:markAttributesSetStockId"
        }


#endif