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

-- * Exported types
    Gutter(..)                              ,
    IsGutter                                ,
    toGutter                                ,
    noGutter                                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveGutterMethod                     ,
#endif


-- ** getPadding #method:getPadding#

#if defined(ENABLE_OVERLOADING)
    GutterGetPaddingMethodInfo              ,
#endif
    gutterGetPadding                        ,


-- ** getRendererAtPos #method:getRendererAtPos#

#if defined(ENABLE_OVERLOADING)
    GutterGetRendererAtPosMethodInfo        ,
#endif
    gutterGetRendererAtPos                  ,


-- ** getView #method:getView#

#if defined(ENABLE_OVERLOADING)
    GutterGetViewMethodInfo                 ,
#endif
    gutterGetView                           ,


-- ** getWindow #method:getWindow#

#if defined(ENABLE_OVERLOADING)
    GutterGetWindowMethodInfo               ,
#endif
    gutterGetWindow                         ,


-- ** getWindowType #method:getWindowType#

#if defined(ENABLE_OVERLOADING)
    GutterGetWindowTypeMethodInfo           ,
#endif
    gutterGetWindowType                     ,


-- ** insert #method:insert#

#if defined(ENABLE_OVERLOADING)
    GutterInsertMethodInfo                  ,
#endif
    gutterInsert                            ,


-- ** queueDraw #method:queueDraw#

#if defined(ENABLE_OVERLOADING)
    GutterQueueDrawMethodInfo               ,
#endif
    gutterQueueDraw                         ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    GutterRemoveMethodInfo                  ,
#endif
    gutterRemove                            ,


-- ** reorder #method:reorder#

#if defined(ENABLE_OVERLOADING)
    GutterReorderMethodInfo                 ,
#endif
    gutterReorder                           ,


-- ** setPadding #method:setPadding#

#if defined(ENABLE_OVERLOADING)
    GutterSetPaddingMethodInfo              ,
#endif
    gutterSetPadding                        ,




 -- * Properties
-- ** view #attr:view#
-- | The t'GI.GtkSource.Objects.View.View' of the gutter.

#if defined(ENABLE_OVERLOADING)
    GutterViewPropertyInfo                  ,
#endif
    constructGutterView                     ,
    getGutterView                           ,
#if defined(ENABLE_OVERLOADING)
    gutterView                              ,
#endif


-- ** windowType #attr:windowType#
-- | The text window type on which the window is placed.

#if defined(ENABLE_OVERLOADING)
    GutterWindowTypePropertyInfo            ,
#endif
    constructGutterWindowType               ,
    getGutterWindowType                     ,
#if defined(ENABLE_OVERLOADING)
    gutterWindowType                        ,
#endif


-- ** xpad #attr:xpad#
-- | The x-padding.

#if defined(ENABLE_OVERLOADING)
    GutterXpadPropertyInfo                  ,
#endif
    constructGutterXpad                     ,
    getGutterXpad                           ,
#if defined(ENABLE_OVERLOADING)
    gutterXpad                              ,
#endif
    setGutterXpad                           ,


-- ** ypad #attr:ypad#
-- | The y-padding.

#if defined(ENABLE_OVERLOADING)
    GutterYpadPropertyInfo                  ,
#endif
    constructGutterYpad                     ,
    getGutterYpad                           ,
#if defined(ENABLE_OVERLOADING)
    gutterYpad                              ,
#endif
    setGutterYpad                           ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.Window as Gdk.Window
import qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.GtkSource.Objects.GutterRenderer as GtkSource.GutterRenderer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.View as GtkSource.View

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

instance GObject Gutter where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_source_gutter_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `Gutter`.
noGutter :: Maybe Gutter
noGutter :: Maybe Gutter
noGutter = Maybe Gutter
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveGutterMethod (t :: Symbol) (o :: *) :: * where
    ResolveGutterMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveGutterMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveGutterMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveGutterMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveGutterMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveGutterMethod "insert" o = GutterInsertMethodInfo
    ResolveGutterMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveGutterMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveGutterMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveGutterMethod "queueDraw" o = GutterQueueDrawMethodInfo
    ResolveGutterMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveGutterMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveGutterMethod "remove" o = GutterRemoveMethodInfo
    ResolveGutterMethod "reorder" o = GutterReorderMethodInfo
    ResolveGutterMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveGutterMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveGutterMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveGutterMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveGutterMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveGutterMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveGutterMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveGutterMethod "getPadding" o = GutterGetPaddingMethodInfo
    ResolveGutterMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveGutterMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveGutterMethod "getRendererAtPos" o = GutterGetRendererAtPosMethodInfo
    ResolveGutterMethod "getView" o = GutterGetViewMethodInfo
    ResolveGutterMethod "getWindow" o = GutterGetWindowMethodInfo
    ResolveGutterMethod "getWindowType" o = GutterGetWindowTypeMethodInfo
    ResolveGutterMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveGutterMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveGutterMethod "setPadding" o = GutterSetPaddingMethodInfo
    ResolveGutterMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveGutterMethod l o = O.MethodResolutionFailed l o

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

#endif

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

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

-- | Construct a `GValueConstruct` with valid value for the “@view@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGutterView :: (IsGutter o, GtkSource.View.IsView a) => a -> IO (GValueConstruct o)
constructGutterView :: a -> IO (GValueConstruct o)
constructGutterView val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "view" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

#if defined(ENABLE_OVERLOADING)
data GutterViewPropertyInfo
instance AttrInfo GutterViewPropertyInfo where
    type AttrAllowedOps GutterViewPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint GutterViewPropertyInfo = IsGutter
    type AttrSetTypeConstraint GutterViewPropertyInfo = GtkSource.View.IsView
    type AttrTransferTypeConstraint GutterViewPropertyInfo = GtkSource.View.IsView
    type AttrTransferType GutterViewPropertyInfo = GtkSource.View.View
    type AttrGetType GutterViewPropertyInfo = GtkSource.View.View
    type AttrLabel GutterViewPropertyInfo = "view"
    type AttrOrigin GutterViewPropertyInfo = Gutter
    attrGet = getGutterView
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo GtkSource.View.View v
    attrConstruct = constructGutterView
    attrClear = undefined
#endif

-- VVV Prop "window-type"
   -- Type: TInterface (Name {namespace = "Gtk", name = "TextWindowType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@window-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' gutter #windowType
-- @
getGutterWindowType :: (MonadIO m, IsGutter o) => o -> m Gtk.Enums.TextWindowType
getGutterWindowType :: o -> m TextWindowType
getGutterWindowType obj :: o
obj = IO TextWindowType -> m TextWindowType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextWindowType -> m TextWindowType)
-> IO TextWindowType -> m TextWindowType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO TextWindowType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "window-type"

-- | Construct a `GValueConstruct` with valid value for the “@window-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGutterWindowType :: (IsGutter o) => Gtk.Enums.TextWindowType -> IO (GValueConstruct o)
constructGutterWindowType :: TextWindowType -> IO (GValueConstruct o)
constructGutterWindowType val :: TextWindowType
val = String -> TextWindowType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "window-type" TextWindowType
val

#if defined(ENABLE_OVERLOADING)
data GutterWindowTypePropertyInfo
instance AttrInfo GutterWindowTypePropertyInfo where
    type AttrAllowedOps GutterWindowTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GutterWindowTypePropertyInfo = IsGutter
    type AttrSetTypeConstraint GutterWindowTypePropertyInfo = (~) Gtk.Enums.TextWindowType
    type AttrTransferTypeConstraint GutterWindowTypePropertyInfo = (~) Gtk.Enums.TextWindowType
    type AttrTransferType GutterWindowTypePropertyInfo = Gtk.Enums.TextWindowType
    type AttrGetType GutterWindowTypePropertyInfo = Gtk.Enums.TextWindowType
    type AttrLabel GutterWindowTypePropertyInfo = "window-type"
    type AttrOrigin GutterWindowTypePropertyInfo = Gutter
    attrGet = getGutterWindowType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructGutterWindowType
    attrClear = undefined
#endif

-- VVV Prop "xpad"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

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

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

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

#if defined(ENABLE_OVERLOADING)
data GutterXpadPropertyInfo
instance AttrInfo GutterXpadPropertyInfo where
    type AttrAllowedOps GutterXpadPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GutterXpadPropertyInfo = IsGutter
    type AttrSetTypeConstraint GutterXpadPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint GutterXpadPropertyInfo = (~) Int32
    type AttrTransferType GutterXpadPropertyInfo = Int32
    type AttrGetType GutterXpadPropertyInfo = Int32
    type AttrLabel GutterXpadPropertyInfo = "xpad"
    type AttrOrigin GutterXpadPropertyInfo = Gutter
    attrGet = getGutterXpad
    attrSet = setGutterXpad
    attrTransfer _ v = do
        return v
    attrConstruct = constructGutterXpad
    attrClear = undefined
#endif

-- VVV Prop "ypad"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

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

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

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

#if defined(ENABLE_OVERLOADING)
data GutterYpadPropertyInfo
instance AttrInfo GutterYpadPropertyInfo where
    type AttrAllowedOps GutterYpadPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GutterYpadPropertyInfo = IsGutter
    type AttrSetTypeConstraint GutterYpadPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint GutterYpadPropertyInfo = (~) Int32
    type AttrTransferType GutterYpadPropertyInfo = Int32
    type AttrGetType GutterYpadPropertyInfo = Int32
    type AttrLabel GutterYpadPropertyInfo = "ypad"
    type AttrOrigin GutterYpadPropertyInfo = Gutter
    attrGet = getGutterYpad
    attrSet = setGutterYpad
    attrTransfer _ v = do
        return v
    attrConstruct = constructGutterYpad
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Gutter
type instance O.AttributeList Gutter = GutterAttributeList
type GutterAttributeList = ('[ '("view", GutterViewPropertyInfo), '("windowType", GutterWindowTypePropertyInfo), '("xpad", GutterXpadPropertyInfo), '("ypad", GutterYpadPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
gutterView :: AttrLabelProxy "view"
gutterView = AttrLabelProxy

gutterWindowType :: AttrLabelProxy "windowType"
gutterWindowType = AttrLabelProxy

gutterXpad :: AttrLabelProxy "xpad"
gutterXpad = AttrLabelProxy

gutterYpad :: AttrLabelProxy "ypad"
gutterYpad = AttrLabelProxy

#endif

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

#endif

-- method Gutter::get_padding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "gutter"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Gutter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "xpad"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ypad"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_gutter_get_padding" gtk_source_gutter_get_padding :: 
    Ptr Gutter ->                           -- gutter : TInterface (Name {namespace = "GtkSource", name = "Gutter"})
    Int32 ->                                -- xpad : TBasicType TInt
    Int32 ->                                -- ypad : TBasicType TInt
    IO ()

{-# DEPRECATED gutterGetPadding ["(Since version 3.12)","Use 'GI.GtkSource.Objects.GutterRenderer.gutterRendererGetPadding' instead."] #-}
-- | /No description available in the introspection data./
gutterGetPadding ::
    (B.CallStack.HasCallStack, MonadIO m, IsGutter a) =>
    a
    -> Int32
    -> Int32
    -> m ()
gutterGetPadding :: a -> Int32 -> Int32 -> m ()
gutterGetPadding gutter :: a
gutter xpad :: Int32
xpad ypad :: Int32
ypad = 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 Gutter
gutter' <- a -> IO (Ptr Gutter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gutter
    Ptr Gutter -> Int32 -> Int32 -> IO ()
gtk_source_gutter_get_padding Ptr Gutter
gutter' Int32
xpad Int32
ypad
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gutter
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GutterGetPaddingMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsGutter a) => O.MethodInfo GutterGetPaddingMethodInfo a signature where
    overloadedMethod = gutterGetPadding

#endif

-- method Gutter::get_renderer_at_pos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "gutter"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Gutter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GtkSourceGutter."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The x position to get identified."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The y position to get identified."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkSource" , name = "GutterRenderer" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_gutter_get_renderer_at_pos" gtk_source_gutter_get_renderer_at_pos :: 
    Ptr Gutter ->                           -- gutter : TInterface (Name {namespace = "GtkSource", name = "Gutter"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO (Ptr GtkSource.GutterRenderer.GutterRenderer)

-- | Finds the t'GI.GtkSource.Objects.GutterRenderer.GutterRenderer' at (x, y).
gutterGetRendererAtPos ::
    (B.CallStack.HasCallStack, MonadIO m, IsGutter a) =>
    a
    -- ^ /@gutter@/: A t'GI.GtkSource.Objects.Gutter.Gutter'.
    -> Int32
    -- ^ /@x@/: The x position to get identified.
    -> Int32
    -- ^ /@y@/: The y position to get identified.
    -> m (Maybe GtkSource.GutterRenderer.GutterRenderer)
    -- ^ __Returns:__ the renderer at (x, y) or 'P.Nothing'.
gutterGetRendererAtPos :: a -> Int32 -> Int32 -> m (Maybe GutterRenderer)
gutterGetRendererAtPos gutter :: a
gutter x :: Int32
x y :: Int32
y = IO (Maybe GutterRenderer) -> m (Maybe GutterRenderer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GutterRenderer) -> m (Maybe GutterRenderer))
-> IO (Maybe GutterRenderer) -> m (Maybe GutterRenderer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Gutter
gutter' <- a -> IO (Ptr Gutter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gutter
    Ptr GutterRenderer
result <- Ptr Gutter -> Int32 -> Int32 -> IO (Ptr GutterRenderer)
gtk_source_gutter_get_renderer_at_pos Ptr Gutter
gutter' Int32
x Int32
y
    Maybe GutterRenderer
maybeResult <- Ptr GutterRenderer
-> (Ptr GutterRenderer -> IO GutterRenderer)
-> IO (Maybe GutterRenderer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GutterRenderer
result ((Ptr GutterRenderer -> IO GutterRenderer)
 -> IO (Maybe GutterRenderer))
-> (Ptr GutterRenderer -> IO GutterRenderer)
-> IO (Maybe GutterRenderer)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr GutterRenderer
result' -> do
        GutterRenderer
result'' <- ((ManagedPtr GutterRenderer -> GutterRenderer)
-> Ptr GutterRenderer -> IO GutterRenderer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr GutterRenderer -> GutterRenderer
GtkSource.GutterRenderer.GutterRenderer) Ptr GutterRenderer
result'
        GutterRenderer -> IO GutterRenderer
forall (m :: * -> *) a. Monad m => a -> m a
return GutterRenderer
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gutter
    Maybe GutterRenderer -> IO (Maybe GutterRenderer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GutterRenderer
maybeResult

#if defined(ENABLE_OVERLOADING)
data GutterGetRendererAtPosMethodInfo
instance (signature ~ (Int32 -> Int32 -> m (Maybe GtkSource.GutterRenderer.GutterRenderer)), MonadIO m, IsGutter a) => O.MethodInfo GutterGetRendererAtPosMethodInfo a signature where
    overloadedMethod = gutterGetRendererAtPos

#endif

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

foreign import ccall "gtk_source_gutter_get_view" gtk_source_gutter_get_view :: 
    Ptr Gutter ->                           -- gutter : TInterface (Name {namespace = "GtkSource", name = "Gutter"})
    IO (Ptr GtkSource.View.View)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.24/
gutterGetView ::
    (B.CallStack.HasCallStack, MonadIO m, IsGutter a) =>
    a
    -- ^ /@gutter@/: a t'GI.GtkSource.Objects.Gutter.Gutter'.
    -> m GtkSource.View.View
    -- ^ __Returns:__ the associated t'GI.GtkSource.Objects.View.View'.
gutterGetView :: a -> m View
gutterGetView gutter :: a
gutter = IO View -> m View
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO View -> m View) -> IO View -> m View
forall a b. (a -> b) -> a -> b
$ do
    Ptr Gutter
gutter' <- a -> IO (Ptr Gutter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gutter
    Ptr View
result <- Ptr Gutter -> IO (Ptr View)
gtk_source_gutter_get_view Ptr Gutter
gutter'
    Text -> Ptr View -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "gutterGetView" Ptr View
result
    View
result' <- ((ManagedPtr View -> View) -> Ptr View -> IO View
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr View -> View
GtkSource.View.View) Ptr View
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gutter
    View -> IO View
forall (m :: * -> *) a. Monad m => a -> m a
return View
result'

#if defined(ENABLE_OVERLOADING)
data GutterGetViewMethodInfo
instance (signature ~ (m GtkSource.View.View), MonadIO m, IsGutter a) => O.MethodInfo GutterGetViewMethodInfo a signature where
    overloadedMethod = gutterGetView

#endif

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

foreign import ccall "gtk_source_gutter_get_window" gtk_source_gutter_get_window :: 
    Ptr Gutter ->                           -- gutter : TInterface (Name {namespace = "GtkSource", name = "Gutter"})
    IO (Ptr Gdk.Window.Window)

{-# DEPRECATED gutterGetWindow ["(Since version 3.12)","Use 'GI.Gtk.Objects.TextView.textViewGetWindow' instead."] #-}
-- | Get the t'GI.Gdk.Objects.Window.Window' of the gutter. The window will only be available when the
-- gutter has at least one, non-zero width, cell renderer packed.
-- 
-- /Since: 2.8/
gutterGetWindow ::
    (B.CallStack.HasCallStack, MonadIO m, IsGutter a) =>
    a
    -- ^ /@gutter@/: a t'GI.GtkSource.Objects.Gutter.Gutter'.
    -> m Gdk.Window.Window
    -- ^ __Returns:__ the t'GI.Gdk.Objects.Window.Window' of the gutter, or 'P.Nothing'
    -- if the gutter has no window.
gutterGetWindow :: a -> m Window
gutterGetWindow gutter :: a
gutter = IO Window -> m Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Window -> m Window) -> IO Window -> m Window
forall a b. (a -> b) -> a -> b
$ do
    Ptr Gutter
gutter' <- a -> IO (Ptr Gutter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gutter
    Ptr Window
result <- Ptr Gutter -> IO (Ptr Window)
gtk_source_gutter_get_window Ptr Gutter
gutter'
    Text -> Ptr Window -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "gutterGetWindow" Ptr Window
result
    Window
result' <- ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Gdk.Window.Window) Ptr Window
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gutter
    Window -> IO Window
forall (m :: * -> *) a. Monad m => a -> m a
return Window
result'

#if defined(ENABLE_OVERLOADING)
data GutterGetWindowMethodInfo
instance (signature ~ (m Gdk.Window.Window), MonadIO m, IsGutter a) => O.MethodInfo GutterGetWindowMethodInfo a signature where
    overloadedMethod = gutterGetWindow

#endif

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

foreign import ccall "gtk_source_gutter_get_window_type" gtk_source_gutter_get_window_type :: 
    Ptr Gutter ->                           -- gutter : TInterface (Name {namespace = "GtkSource", name = "Gutter"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.24/
gutterGetWindowType ::
    (B.CallStack.HasCallStack, MonadIO m, IsGutter a) =>
    a
    -- ^ /@gutter@/: a t'GI.GtkSource.Objects.Gutter.Gutter'.
    -> m Gtk.Enums.TextWindowType
    -- ^ __Returns:__ the t'GI.Gtk.Enums.TextWindowType' of /@gutter@/.
gutterGetWindowType :: a -> m TextWindowType
gutterGetWindowType gutter :: a
gutter = IO TextWindowType -> m TextWindowType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextWindowType -> m TextWindowType)
-> IO TextWindowType -> m TextWindowType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Gutter
gutter' <- a -> IO (Ptr Gutter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gutter
    CUInt
result <- Ptr Gutter -> IO CUInt
gtk_source_gutter_get_window_type Ptr Gutter
gutter'
    let result' :: TextWindowType
result' = (Int -> TextWindowType
forall a. Enum a => Int -> a
toEnum (Int -> TextWindowType)
-> (CUInt -> Int) -> CUInt -> TextWindowType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gutter
    TextWindowType -> IO TextWindowType
forall (m :: * -> *) a. Monad m => a -> m a
return TextWindowType
result'

#if defined(ENABLE_OVERLOADING)
data GutterGetWindowTypeMethodInfo
instance (signature ~ (m Gtk.Enums.TextWindowType), MonadIO m, IsGutter a) => O.MethodInfo GutterGetWindowTypeMethodInfo a signature where
    overloadedMethod = gutterGetWindowType

#endif

-- method Gutter::insert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "gutter"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Gutter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceGutter."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "renderer"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "GutterRenderer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a gutter renderer (must inherit from #GtkSourceGutterRenderer)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the renderer position."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_gutter_insert" gtk_source_gutter_insert :: 
    Ptr Gutter ->                           -- gutter : TInterface (Name {namespace = "GtkSource", name = "Gutter"})
    Ptr GtkSource.GutterRenderer.GutterRenderer -> -- renderer : TInterface (Name {namespace = "GtkSource", name = "GutterRenderer"})
    Int32 ->                                -- position : TBasicType TInt
    IO CInt

-- | Insert /@renderer@/ into the gutter. If /@renderer@/ is yet unowned then gutter
-- claims its ownership. Otherwise just increases renderer\'s reference count.
-- /@renderer@/ cannot be already inserted to another gutter.
-- 
-- /Since: 3.0/
gutterInsert ::
    (B.CallStack.HasCallStack, MonadIO m, IsGutter a, GtkSource.GutterRenderer.IsGutterRenderer b) =>
    a
    -- ^ /@gutter@/: a t'GI.GtkSource.Objects.Gutter.Gutter'.
    -> b
    -- ^ /@renderer@/: a gutter renderer (must inherit from t'GI.GtkSource.Objects.GutterRenderer.GutterRenderer').
    -> Int32
    -- ^ /@position@/: the renderer position.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if operation succeeded. Otherwise 'P.False'.
gutterInsert :: a -> b -> Int32 -> m Bool
gutterInsert gutter :: a
gutter renderer :: b
renderer position :: Int32
position = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Gutter
gutter' <- a -> IO (Ptr Gutter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gutter
    Ptr GutterRenderer
renderer' <- b -> IO (Ptr GutterRenderer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
renderer
    CInt
result <- Ptr Gutter -> Ptr GutterRenderer -> Int32 -> IO CInt
gtk_source_gutter_insert Ptr Gutter
gutter' Ptr GutterRenderer
renderer' Int32
position
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gutter
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
renderer
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data GutterInsertMethodInfo
instance (signature ~ (b -> Int32 -> m Bool), MonadIO m, IsGutter a, GtkSource.GutterRenderer.IsGutterRenderer b) => O.MethodInfo GutterInsertMethodInfo a signature where
    overloadedMethod = gutterInsert

#endif

-- method Gutter::queue_draw
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "gutter"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Gutter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceGutter."
--                 , 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_gutter_queue_draw" gtk_source_gutter_queue_draw :: 
    Ptr Gutter ->                           -- gutter : TInterface (Name {namespace = "GtkSource", name = "Gutter"})
    IO ()

-- | Invalidates the drawable area of the gutter. You can use this to force a
-- redraw of the gutter if something has changed and needs to be redrawn.
-- 
-- /Since: 2.8/
gutterQueueDraw ::
    (B.CallStack.HasCallStack, MonadIO m, IsGutter a) =>
    a
    -- ^ /@gutter@/: a t'GI.GtkSource.Objects.Gutter.Gutter'.
    -> m ()
gutterQueueDraw :: a -> m ()
gutterQueueDraw gutter :: a
gutter = 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 Gutter
gutter' <- a -> IO (Ptr Gutter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gutter
    Ptr Gutter -> IO ()
gtk_source_gutter_queue_draw Ptr Gutter
gutter'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gutter
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GutterQueueDrawMethodInfo
instance (signature ~ (m ()), MonadIO m, IsGutter a) => O.MethodInfo GutterQueueDrawMethodInfo a signature where
    overloadedMethod = gutterQueueDraw

#endif

-- method Gutter::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "gutter"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Gutter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceGutter."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "renderer"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "GutterRenderer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceGutterRenderer."
--                 , 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_gutter_remove" gtk_source_gutter_remove :: 
    Ptr Gutter ->                           -- gutter : TInterface (Name {namespace = "GtkSource", name = "Gutter"})
    Ptr GtkSource.GutterRenderer.GutterRenderer -> -- renderer : TInterface (Name {namespace = "GtkSource", name = "GutterRenderer"})
    IO ()

-- | Removes /@renderer@/ from /@gutter@/.
-- 
-- /Since: 2.8/
gutterRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsGutter a, GtkSource.GutterRenderer.IsGutterRenderer b) =>
    a
    -- ^ /@gutter@/: a t'GI.GtkSource.Objects.Gutter.Gutter'.
    -> b
    -- ^ /@renderer@/: a t'GI.GtkSource.Objects.GutterRenderer.GutterRenderer'.
    -> m ()
gutterRemove :: a -> b -> m ()
gutterRemove gutter :: a
gutter renderer :: b
renderer = 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 Gutter
gutter' <- a -> IO (Ptr Gutter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gutter
    Ptr GutterRenderer
renderer' <- b -> IO (Ptr GutterRenderer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
renderer
    Ptr Gutter -> Ptr GutterRenderer -> IO ()
gtk_source_gutter_remove Ptr Gutter
gutter' Ptr GutterRenderer
renderer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gutter
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
renderer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GutterRemoveMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsGutter a, GtkSource.GutterRenderer.IsGutterRenderer b) => O.MethodInfo GutterRemoveMethodInfo a signature where
    overloadedMethod = gutterRemove

#endif

-- method Gutter::reorder
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "gutter"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Gutter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceGutterRenderer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "renderer"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "GutterRenderer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkCellRenderer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new renderer position."
--                 , 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_gutter_reorder" gtk_source_gutter_reorder :: 
    Ptr Gutter ->                           -- gutter : TInterface (Name {namespace = "GtkSource", name = "Gutter"})
    Ptr GtkSource.GutterRenderer.GutterRenderer -> -- renderer : TInterface (Name {namespace = "GtkSource", name = "GutterRenderer"})
    Int32 ->                                -- position : TBasicType TInt
    IO ()

-- | Reorders /@renderer@/ in /@gutter@/ to new /@position@/.
-- 
-- /Since: 2.8/
gutterReorder ::
    (B.CallStack.HasCallStack, MonadIO m, IsGutter a, GtkSource.GutterRenderer.IsGutterRenderer b) =>
    a
    -- ^ /@gutter@/: a t'GI.GtkSource.Objects.GutterRenderer.GutterRenderer'.
    -> b
    -- ^ /@renderer@/: a t'GI.Gtk.Objects.CellRenderer.CellRenderer'.
    -> Int32
    -- ^ /@position@/: the new renderer position.
    -> m ()
gutterReorder :: a -> b -> Int32 -> m ()
gutterReorder gutter :: a
gutter renderer :: b
renderer position :: Int32
position = 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 Gutter
gutter' <- a -> IO (Ptr Gutter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gutter
    Ptr GutterRenderer
renderer' <- b -> IO (Ptr GutterRenderer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
renderer
    Ptr Gutter -> Ptr GutterRenderer -> Int32 -> IO ()
gtk_source_gutter_reorder Ptr Gutter
gutter' Ptr GutterRenderer
renderer' Int32
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gutter
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
renderer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GutterReorderMethodInfo
instance (signature ~ (b -> Int32 -> m ()), MonadIO m, IsGutter a, GtkSource.GutterRenderer.IsGutterRenderer b) => O.MethodInfo GutterReorderMethodInfo a signature where
    overloadedMethod = gutterReorder

#endif

-- method Gutter::set_padding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "gutter"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Gutter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "xpad"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ypad"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_gutter_set_padding" gtk_source_gutter_set_padding :: 
    Ptr Gutter ->                           -- gutter : TInterface (Name {namespace = "GtkSource", name = "Gutter"})
    Int32 ->                                -- xpad : TBasicType TInt
    Int32 ->                                -- ypad : TBasicType TInt
    IO ()

{-# DEPRECATED gutterSetPadding ["(Since version 3.12)","Use 'GI.GtkSource.Objects.GutterRenderer.gutterRendererSetPadding' instead."] #-}
-- | /No description available in the introspection data./
gutterSetPadding ::
    (B.CallStack.HasCallStack, MonadIO m, IsGutter a) =>
    a
    -> Int32
    -> Int32
    -> m ()
gutterSetPadding :: a -> Int32 -> Int32 -> m ()
gutterSetPadding gutter :: a
gutter xpad :: Int32
xpad ypad :: Int32
ypad = 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 Gutter
gutter' <- a -> IO (Ptr Gutter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gutter
    Ptr Gutter -> Int32 -> Int32 -> IO ()
gtk_source_gutter_set_padding Ptr Gutter
gutter' Int32
xpad Int32
ypad
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gutter
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GutterSetPaddingMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsGutter a) => O.MethodInfo GutterSetPaddingMethodInfo a signature where
    overloadedMethod = gutterSetPadding

#endif