{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Pango.Objects.Context.Context' structure stores global information
-- used to control the itemization process.

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

module GI.Pango.Objects.Context
    ( 

-- * Exported types
    Context(..)                             ,
    IsContext                               ,
    toContext                               ,
    noContext                               ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveContextMethod                    ,
#endif


-- ** changed #method:changed#

#if defined(ENABLE_OVERLOADING)
    ContextChangedMethodInfo                ,
#endif
    contextChanged                          ,


-- ** getBaseDir #method:getBaseDir#

#if defined(ENABLE_OVERLOADING)
    ContextGetBaseDirMethodInfo             ,
#endif
    contextGetBaseDir                       ,


-- ** getBaseGravity #method:getBaseGravity#

#if defined(ENABLE_OVERLOADING)
    ContextGetBaseGravityMethodInfo         ,
#endif
    contextGetBaseGravity                   ,


-- ** getFontDescription #method:getFontDescription#

#if defined(ENABLE_OVERLOADING)
    ContextGetFontDescriptionMethodInfo     ,
#endif
    contextGetFontDescription               ,


-- ** getFontMap #method:getFontMap#

#if defined(ENABLE_OVERLOADING)
    ContextGetFontMapMethodInfo             ,
#endif
    contextGetFontMap                       ,


-- ** getGravity #method:getGravity#

#if defined(ENABLE_OVERLOADING)
    ContextGetGravityMethodInfo             ,
#endif
    contextGetGravity                       ,


-- ** getGravityHint #method:getGravityHint#

#if defined(ENABLE_OVERLOADING)
    ContextGetGravityHintMethodInfo         ,
#endif
    contextGetGravityHint                   ,


-- ** getLanguage #method:getLanguage#

#if defined(ENABLE_OVERLOADING)
    ContextGetLanguageMethodInfo            ,
#endif
    contextGetLanguage                      ,


-- ** getMatrix #method:getMatrix#

#if defined(ENABLE_OVERLOADING)
    ContextGetMatrixMethodInfo              ,
#endif
    contextGetMatrix                        ,


-- ** getMetrics #method:getMetrics#

#if defined(ENABLE_OVERLOADING)
    ContextGetMetricsMethodInfo             ,
#endif
    contextGetMetrics                       ,


-- ** getSerial #method:getSerial#

#if defined(ENABLE_OVERLOADING)
    ContextGetSerialMethodInfo              ,
#endif
    contextGetSerial                        ,


-- ** listFamilies #method:listFamilies#

#if defined(ENABLE_OVERLOADING)
    ContextListFamiliesMethodInfo           ,
#endif
    contextListFamilies                     ,


-- ** loadFont #method:loadFont#

#if defined(ENABLE_OVERLOADING)
    ContextLoadFontMethodInfo               ,
#endif
    contextLoadFont                         ,


-- ** loadFontset #method:loadFontset#

#if defined(ENABLE_OVERLOADING)
    ContextLoadFontsetMethodInfo            ,
#endif
    contextLoadFontset                      ,


-- ** new #method:new#

    contextNew                              ,


-- ** setBaseDir #method:setBaseDir#

#if defined(ENABLE_OVERLOADING)
    ContextSetBaseDirMethodInfo             ,
#endif
    contextSetBaseDir                       ,


-- ** setBaseGravity #method:setBaseGravity#

#if defined(ENABLE_OVERLOADING)
    ContextSetBaseGravityMethodInfo         ,
#endif
    contextSetBaseGravity                   ,


-- ** setFontDescription #method:setFontDescription#

#if defined(ENABLE_OVERLOADING)
    ContextSetFontDescriptionMethodInfo     ,
#endif
    contextSetFontDescription               ,


-- ** setFontMap #method:setFontMap#

#if defined(ENABLE_OVERLOADING)
    ContextSetFontMapMethodInfo             ,
#endif
    contextSetFontMap                       ,


-- ** setGravityHint #method:setGravityHint#

#if defined(ENABLE_OVERLOADING)
    ContextSetGravityHintMethodInfo         ,
#endif
    contextSetGravityHint                   ,


-- ** setLanguage #method:setLanguage#

#if defined(ENABLE_OVERLOADING)
    ContextSetLanguageMethodInfo            ,
#endif
    contextSetLanguage                      ,


-- ** setMatrix #method:setMatrix#

#if defined(ENABLE_OVERLOADING)
    ContextSetMatrixMethodInfo              ,
#endif
    contextSetMatrix                        ,




    ) 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 {-# SOURCE #-} qualified GI.Pango.Enums as Pango.Enums
import {-# SOURCE #-} qualified GI.Pango.Objects.Font as Pango.Font
import {-# SOURCE #-} qualified GI.Pango.Objects.FontFamily as Pango.FontFamily
import {-# SOURCE #-} qualified GI.Pango.Objects.FontMap as Pango.FontMap
import {-# SOURCE #-} qualified GI.Pango.Objects.Fontset as Pango.Fontset
import {-# SOURCE #-} qualified GI.Pango.Structs.FontDescription as Pango.FontDescription
import {-# SOURCE #-} qualified GI.Pango.Structs.FontMetrics as Pango.FontMetrics
import {-# SOURCE #-} qualified GI.Pango.Structs.Language as Pango.Language
import {-# SOURCE #-} qualified GI.Pango.Structs.Matrix as Pango.Matrix

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

instance GObject Context where
    gobjectType :: IO GType
gobjectType = IO GType
c_pango_context_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `Context`.
noContext :: Maybe Context
noContext :: Maybe Context
noContext = Maybe Context
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveContextMethod (t :: Symbol) (o :: *) :: * where
    ResolveContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveContextMethod "changed" o = ContextChangedMethodInfo
    ResolveContextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveContextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveContextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveContextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveContextMethod "listFamilies" o = ContextListFamiliesMethodInfo
    ResolveContextMethod "loadFont" o = ContextLoadFontMethodInfo
    ResolveContextMethod "loadFontset" o = ContextLoadFontsetMethodInfo
    ResolveContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveContextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveContextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveContextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveContextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveContextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveContextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveContextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveContextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveContextMethod "getBaseDir" o = ContextGetBaseDirMethodInfo
    ResolveContextMethod "getBaseGravity" o = ContextGetBaseGravityMethodInfo
    ResolveContextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveContextMethod "getFontDescription" o = ContextGetFontDescriptionMethodInfo
    ResolveContextMethod "getFontMap" o = ContextGetFontMapMethodInfo
    ResolveContextMethod "getGravity" o = ContextGetGravityMethodInfo
    ResolveContextMethod "getGravityHint" o = ContextGetGravityHintMethodInfo
    ResolveContextMethod "getLanguage" o = ContextGetLanguageMethodInfo
    ResolveContextMethod "getMatrix" o = ContextGetMatrixMethodInfo
    ResolveContextMethod "getMetrics" o = ContextGetMetricsMethodInfo
    ResolveContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveContextMethod "getSerial" o = ContextGetSerialMethodInfo
    ResolveContextMethod "setBaseDir" o = ContextSetBaseDirMethodInfo
    ResolveContextMethod "setBaseGravity" o = ContextSetBaseGravityMethodInfo
    ResolveContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveContextMethod "setFontDescription" o = ContextSetFontDescriptionMethodInfo
    ResolveContextMethod "setFontMap" o = ContextSetFontMapMethodInfo
    ResolveContextMethod "setGravityHint" o = ContextSetGravityHintMethodInfo
    ResolveContextMethod "setLanguage" o = ContextSetLanguageMethodInfo
    ResolveContextMethod "setMatrix" o = ContextSetMatrixMethodInfo
    ResolveContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveContextMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Context
type instance O.AttributeList Context = ContextAttributeList
type ContextAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "pango_context_new" pango_context_new :: 
    IO (Ptr Context)

-- | Creates a new t'GI.Pango.Objects.Context.Context' initialized to default values.
-- 
-- This function is not particularly useful as it should always
-- be followed by a 'GI.Pango.Objects.Context.contextSetFontMap' call, and the
-- function 'GI.Pango.Objects.FontMap.fontMapCreateContext' does these two steps
-- together and hence users are recommended to use that.
-- 
-- If you are using Pango as part of a higher-level system,
-- that system may have it\'s own way of create a t'GI.Pango.Objects.Context.Context'.
-- For instance, the GTK+ toolkit has, among others,
-- @/gdk_pango_context_get_for_screen()/@, and
-- @/gtk_widget_get_pango_context()/@.  Use those instead.
contextNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Context
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Objects.Context.Context', which should
    --               be freed with 'GI.GObject.Objects.Object.objectUnref'.
contextNew :: m Context
contextNew  = IO Context -> m Context
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
result <- IO (Ptr Context)
pango_context_new
    Text -> Ptr Context -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextNew" Ptr Context
result
    Context
result' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Context -> Context
Context) Ptr Context
result
    Context -> IO Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Context::changed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_changed" pango_context_changed :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    IO ()

-- | Forces a change in the context, which will cause any t'GI.Pango.Objects.Layout.Layout'
-- using this context to re-layout.
-- 
-- This function is only useful when implementing a new backend
-- for Pango, something applications won\'t do. Backends should
-- call this function if they have attached extra data to the context
-- and such data is changed.
-- 
-- /Since: 1.32.4/
contextChanged ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m ()
contextChanged :: a -> m ()
contextChanged context :: a
context = 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 Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Context -> IO ()
pango_context_changed Ptr Context
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextChangedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsContext a) => O.MethodInfo ContextChangedMethodInfo a signature where
    overloadedMethod = contextChanged

#endif

-- method Context::get_base_dir
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Direction" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_get_base_dir" pango_context_get_base_dir :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    IO CUInt

-- | Retrieves the base direction for the context. See
-- 'GI.Pango.Objects.Context.contextSetBaseDir'.
contextGetBaseDir ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m Pango.Enums.Direction
    -- ^ __Returns:__ the base direction for the context.
contextGetBaseDir :: a -> m Direction
contextGetBaseDir context :: a
context = IO Direction -> m Direction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Direction -> m Direction) -> IO Direction -> m Direction
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CUInt
result <- Ptr Context -> IO CUInt
pango_context_get_base_dir Ptr Context
context'
    let result' :: Direction
result' = (Int -> Direction
forall a. Enum a => Int -> a
toEnum (Int -> Direction) -> (CUInt -> Int) -> CUInt -> Direction
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
context
    Direction -> IO Direction
forall (m :: * -> *) a. Monad m => a -> m a
return Direction
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetBaseDirMethodInfo
instance (signature ~ (m Pango.Enums.Direction), MonadIO m, IsContext a) => O.MethodInfo ContextGetBaseDirMethodInfo a signature where
    overloadedMethod = contextGetBaseDir

#endif

-- method Context::get_base_gravity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Gravity" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_get_base_gravity" pango_context_get_base_gravity :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    IO CUInt

-- | Retrieves the base gravity for the context. See
-- 'GI.Pango.Objects.Context.contextSetBaseGravity'.
-- 
-- /Since: 1.16/
contextGetBaseGravity ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m Pango.Enums.Gravity
    -- ^ __Returns:__ the base gravity for the context.
contextGetBaseGravity :: a -> m Gravity
contextGetBaseGravity context :: a
context = IO Gravity -> m Gravity
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Gravity -> m Gravity) -> IO Gravity -> m Gravity
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CUInt
result <- Ptr Context -> IO CUInt
pango_context_get_base_gravity Ptr Context
context'
    let result' :: Gravity
result' = (Int -> Gravity
forall a. Enum a => Int -> a
toEnum (Int -> Gravity) -> (CUInt -> Int) -> CUInt -> Gravity
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
context
    Gravity -> IO Gravity
forall (m :: * -> *) a. Monad m => a -> m a
return Gravity
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetBaseGravityMethodInfo
instance (signature ~ (m Pango.Enums.Gravity), MonadIO m, IsContext a) => O.MethodInfo ContextGetBaseGravityMethodInfo a signature where
    overloadedMethod = contextGetBaseGravity

#endif

-- method Context::get_font_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Pango" , name = "FontDescription" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_get_font_description" pango_context_get_font_description :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    IO (Ptr Pango.FontDescription.FontDescription)

-- | Retrieve the default font description for the context.
contextGetFontDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m Pango.FontDescription.FontDescription
    -- ^ __Returns:__ a pointer to the context\'s default font
    --               description. This value must not be modified or freed.
contextGetFontDescription :: a -> m FontDescription
contextGetFontDescription context :: a
context = IO FontDescription -> m FontDescription
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontDescription -> m FontDescription)
-> IO FontDescription -> m FontDescription
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr FontDescription
result <- Ptr Context -> IO (Ptr FontDescription)
pango_context_get_font_description Ptr Context
context'
    Text -> Ptr FontDescription -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextGetFontDescription" Ptr FontDescription
result
    FontDescription
result' <- ((ManagedPtr FontDescription -> FontDescription)
-> Ptr FontDescription -> IO FontDescription
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr FontDescription -> FontDescription
Pango.FontDescription.FontDescription) Ptr FontDescription
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetFontDescriptionMethodInfo
instance (signature ~ (m Pango.FontDescription.FontDescription), MonadIO m, IsContext a) => O.MethodInfo ContextGetFontDescriptionMethodInfo a signature where
    overloadedMethod = contextGetFontDescription

#endif

-- method Context::get_font_map
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "FontMap" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_get_font_map" pango_context_get_font_map :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    IO (Ptr Pango.FontMap.FontMap)

-- | Gets the t'GI.Pango.Objects.FontMap.FontMap' used to look up fonts for this context.
-- 
-- /Since: 1.6/
contextGetFontMap ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m Pango.FontMap.FontMap
    -- ^ __Returns:__ the font map for the t'GI.Pango.Objects.Context.Context'.
    --               This value is owned by Pango and should not be unreferenced.
contextGetFontMap :: a -> m FontMap
contextGetFontMap context :: a
context = IO FontMap -> m FontMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontMap -> m FontMap) -> IO FontMap -> m FontMap
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr FontMap
result <- Ptr Context -> IO (Ptr FontMap)
pango_context_get_font_map Ptr Context
context'
    Text -> Ptr FontMap -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextGetFontMap" Ptr FontMap
result
    FontMap
result' <- ((ManagedPtr FontMap -> FontMap) -> Ptr FontMap -> IO FontMap
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr FontMap -> FontMap
Pango.FontMap.FontMap) Ptr FontMap
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    FontMap -> IO FontMap
forall (m :: * -> *) a. Monad m => a -> m a
return FontMap
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetFontMapMethodInfo
instance (signature ~ (m Pango.FontMap.FontMap), MonadIO m, IsContext a) => O.MethodInfo ContextGetFontMapMethodInfo a signature where
    overloadedMethod = contextGetFontMap

#endif

-- method Context::get_gravity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Gravity" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_get_gravity" pango_context_get_gravity :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    IO CUInt

-- | Retrieves the gravity for the context. This is similar to
-- 'GI.Pango.Objects.Context.contextGetBaseGravity', except for when the base gravity
-- is 'GI.Pango.Enums.GravityAuto' for which 'GI.Pango.Functions.gravityGetForMatrix' is used
-- to return the gravity from the current context matrix.
-- 
-- /Since: 1.16/
contextGetGravity ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m Pango.Enums.Gravity
    -- ^ __Returns:__ the resolved gravity for the context.
contextGetGravity :: a -> m Gravity
contextGetGravity context :: a
context = IO Gravity -> m Gravity
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Gravity -> m Gravity) -> IO Gravity -> m Gravity
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CUInt
result <- Ptr Context -> IO CUInt
pango_context_get_gravity Ptr Context
context'
    let result' :: Gravity
result' = (Int -> Gravity
forall a. Enum a => Int -> a
toEnum (Int -> Gravity) -> (CUInt -> Int) -> CUInt -> Gravity
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
context
    Gravity -> IO Gravity
forall (m :: * -> *) a. Monad m => a -> m a
return Gravity
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetGravityMethodInfo
instance (signature ~ (m Pango.Enums.Gravity), MonadIO m, IsContext a) => O.MethodInfo ContextGetGravityMethodInfo a signature where
    overloadedMethod = contextGetGravity

#endif

-- method Context::get_gravity_hint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Pango" , name = "GravityHint" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_get_gravity_hint" pango_context_get_gravity_hint :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    IO CUInt

-- | Retrieves the gravity hint for the context. See
-- 'GI.Pango.Objects.Context.contextSetGravityHint' for details.
-- 
-- /Since: 1.16/
contextGetGravityHint ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m Pango.Enums.GravityHint
    -- ^ __Returns:__ the gravity hint for the context.
contextGetGravityHint :: a -> m GravityHint
contextGetGravityHint context :: a
context = IO GravityHint -> m GravityHint
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GravityHint -> m GravityHint)
-> IO GravityHint -> m GravityHint
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CUInt
result <- Ptr Context -> IO CUInt
pango_context_get_gravity_hint Ptr Context
context'
    let result' :: GravityHint
result' = (Int -> GravityHint
forall a. Enum a => Int -> a
toEnum (Int -> GravityHint) -> (CUInt -> Int) -> CUInt -> GravityHint
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
context
    GravityHint -> IO GravityHint
forall (m :: * -> *) a. Monad m => a -> m a
return GravityHint
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetGravityHintMethodInfo
instance (signature ~ (m Pango.Enums.GravityHint), MonadIO m, IsContext a) => O.MethodInfo ContextGetGravityHintMethodInfo a signature where
    overloadedMethod = contextGetGravityHint

#endif

-- method Context::get_language
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Language" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_get_language" pango_context_get_language :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    IO (Ptr Pango.Language.Language)

-- | Retrieves the global language tag for the context.
contextGetLanguage ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m Pango.Language.Language
    -- ^ __Returns:__ the global language tag.
contextGetLanguage :: a -> m Language
contextGetLanguage context :: a
context = IO Language -> m Language
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Language -> m Language) -> IO Language -> m Language
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Language
result <- Ptr Context -> IO (Ptr Language)
pango_context_get_language Ptr Context
context'
    Text -> Ptr Language -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextGetLanguage" Ptr Language
result
    Language
result' <- ((ManagedPtr Language -> Language) -> Ptr Language -> IO Language
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Language -> Language
Pango.Language.Language) Ptr Language
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Language -> IO Language
forall (m :: * -> *) a. Monad m => a -> m a
return Language
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetLanguageMethodInfo
instance (signature ~ (m Pango.Language.Language), MonadIO m, IsContext a) => O.MethodInfo ContextGetLanguageMethodInfo a signature where
    overloadedMethod = contextGetLanguage

#endif

-- method Context::get_matrix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Matrix" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_get_matrix" pango_context_get_matrix :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    IO (Ptr Pango.Matrix.Matrix)

-- | Gets the transformation matrix that will be applied when
-- rendering with this context. See 'GI.Pango.Objects.Context.contextSetMatrix'.
-- 
-- /Since: 1.6/
contextGetMatrix ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m (Maybe Pango.Matrix.Matrix)
    -- ^ __Returns:__ the matrix, or 'P.Nothing' if no matrix has
    --  been set (which is the same as the identity matrix). The returned
    --  matrix is owned by Pango and must not be modified or freed.
contextGetMatrix :: a -> m (Maybe Matrix)
contextGetMatrix context :: a
context = IO (Maybe Matrix) -> m (Maybe Matrix)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Matrix) -> m (Maybe Matrix))
-> IO (Maybe Matrix) -> m (Maybe Matrix)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Matrix
result <- Ptr Context -> IO (Ptr Matrix)
pango_context_get_matrix Ptr Context
context'
    Maybe Matrix
maybeResult <- Ptr Matrix -> (Ptr Matrix -> IO Matrix) -> IO (Maybe Matrix)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Matrix
result ((Ptr Matrix -> IO Matrix) -> IO (Maybe Matrix))
-> (Ptr Matrix -> IO Matrix) -> IO (Maybe Matrix)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Matrix
result' -> do
        Matrix
result'' <- ((ManagedPtr Matrix -> Matrix) -> Ptr Matrix -> IO Matrix
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Matrix -> Matrix
Pango.Matrix.Matrix) Ptr Matrix
result'
        Matrix -> IO Matrix
forall (m :: * -> *) a. Monad m => a -> m a
return Matrix
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe Matrix -> IO (Maybe Matrix)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Matrix
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContextGetMatrixMethodInfo
instance (signature ~ (m (Maybe Pango.Matrix.Matrix)), MonadIO m, IsContext a) => O.MethodInfo ContextGetMatrixMethodInfo a signature where
    overloadedMethod = contextGetMatrix

#endif

-- method Context::get_metrics
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #PangoFontDescription structure.  %NULL means that the\n           font description from the context will be used."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "language"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Language" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "language tag used to determine which script to get\n           the metrics for. %NULL means that the language tag from the context\n           will be used. If no language tag is set on the context, metrics\n           for the default language (as determined by pango_language_get_default())\n           will be returned."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Pango" , name = "FontMetrics" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_get_metrics" pango_context_get_metrics :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    Ptr Pango.FontDescription.FontDescription -> -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Ptr Pango.Language.Language ->          -- language : TInterface (Name {namespace = "Pango", name = "Language"})
    IO (Ptr Pango.FontMetrics.FontMetrics)

-- | Get overall metric information for a particular font
-- description.  Since the metrics may be substantially different for
-- different scripts, a language tag can be provided to indicate that
-- the metrics should be retrieved that correspond to the script(s)
-- used by that language.
-- 
-- The t'GI.Pango.Structs.FontDescription.FontDescription' is interpreted in the same way as
-- by 'GI.Pango.Functions.itemize', and the family name may be a comma separated
-- list of figures. If characters from multiple of these families
-- would be used to render the string, then the returned fonts would
-- be a composite of the metrics for the fonts loaded for the
-- individual families.
contextGetMetrics ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> Maybe (Pango.FontDescription.FontDescription)
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription' structure.  'P.Nothing' means that the
    --            font description from the context will be used.
    -> Maybe (Pango.Language.Language)
    -- ^ /@language@/: language tag used to determine which script to get
    --            the metrics for. 'P.Nothing' means that the language tag from the context
    --            will be used. If no language tag is set on the context, metrics
    --            for the default language (as determined by 'GI.Pango.Functions.languageGetDefault')
    --            will be returned.
    -> m Pango.FontMetrics.FontMetrics
    -- ^ __Returns:__ a t'GI.Pango.Structs.FontMetrics.FontMetrics' object. The caller must call 'GI.Pango.Structs.FontMetrics.fontMetricsUnref'
    --   when finished using the object.
contextGetMetrics :: a -> Maybe FontDescription -> Maybe Language -> m FontMetrics
contextGetMetrics context :: a
context desc :: Maybe FontDescription
desc language :: Maybe Language
language = IO FontMetrics -> m FontMetrics
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontMetrics -> m FontMetrics)
-> IO FontMetrics -> m FontMetrics
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr FontDescription
maybeDesc <- case Maybe FontDescription
desc of
        Nothing -> Ptr FontDescription -> IO (Ptr FontDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontDescription
forall a. Ptr a
nullPtr
        Just jDesc :: FontDescription
jDesc -> do
            Ptr FontDescription
jDesc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
jDesc
            Ptr FontDescription -> IO (Ptr FontDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontDescription
jDesc'
    Ptr Language
maybeLanguage <- case Maybe Language
language of
        Nothing -> Ptr Language -> IO (Ptr Language)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Language
forall a. Ptr a
nullPtr
        Just jLanguage :: Language
jLanguage -> do
            Ptr Language
jLanguage' <- Language -> IO (Ptr Language)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Language
jLanguage
            Ptr Language -> IO (Ptr Language)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Language
jLanguage'
    Ptr FontMetrics
result <- Ptr Context
-> Ptr FontDescription -> Ptr Language -> IO (Ptr FontMetrics)
pango_context_get_metrics Ptr Context
context' Ptr FontDescription
maybeDesc Ptr Language
maybeLanguage
    Text -> Ptr FontMetrics -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextGetMetrics" Ptr FontMetrics
result
    FontMetrics
result' <- ((ManagedPtr FontMetrics -> FontMetrics)
-> Ptr FontMetrics -> IO FontMetrics
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontMetrics -> FontMetrics
Pango.FontMetrics.FontMetrics) Ptr FontMetrics
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe FontDescription -> (FontDescription -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe FontDescription
desc FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Language -> (Language -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Language
language Language -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    FontMetrics -> IO FontMetrics
forall (m :: * -> *) a. Monad m => a -> m a
return FontMetrics
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetMetricsMethodInfo
instance (signature ~ (Maybe (Pango.FontDescription.FontDescription) -> Maybe (Pango.Language.Language) -> m Pango.FontMetrics.FontMetrics), MonadIO m, IsContext a) => O.MethodInfo ContextGetMetricsMethodInfo a signature where
    overloadedMethod = contextGetMetrics

#endif

-- method Context::get_serial
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_get_serial" pango_context_get_serial :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    IO Word32

-- | Returns the current serial number of /@context@/.  The serial number is
-- initialized to an small number larger than zero when a new context
-- is created and is increased whenever the context is changed using any
-- of the setter functions, or the t'GI.Pango.Objects.FontMap.FontMap' it uses to find fonts has
-- changed. The serial may wrap, but will never have the value 0. Since it
-- can wrap, never compare it with \"less than\", always use \"not equals\".
-- 
-- This can be used to automatically detect changes to a t'GI.Pango.Objects.Context.Context', and
-- is only useful when implementing objects that need update when their
-- t'GI.Pango.Objects.Context.Context' changes, like t'GI.Pango.Objects.Layout.Layout'.
-- 
-- /Since: 1.32.4/
contextGetSerial ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m Word32
    -- ^ __Returns:__ The current serial number of /@context@/.
contextGetSerial :: a -> m Word32
contextGetSerial context :: a
context = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Word32
result <- Ptr Context -> IO Word32
pango_context_get_serial Ptr Context
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ContextGetSerialMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsContext a) => O.MethodInfo ContextGetSerialMethodInfo a signature where
    overloadedMethod = contextGetSerial

#endif

-- method Context::list_families
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "families"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Pango" , name = "FontFamily" })
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store a pointer to\n           an array of #PangoFontFamily *. This array should be freed\n           with g_free()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferContainer
--           }
--       , Arg
--           { argCName = "n_families"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location to store the number of elements in @descs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_families"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "location to store the number of elements in @descs"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_list_families" pango_context_list_families :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    Ptr (Ptr (Ptr Pango.FontFamily.FontFamily)) -> -- families : TCArray False (-1) 2 (TInterface (Name {namespace = "Pango", name = "FontFamily"}))
    Ptr Int32 ->                            -- n_families : TBasicType TInt
    IO ()

-- | List all families for a context.
contextListFamilies ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> m ([Pango.FontFamily.FontFamily])
contextListFamilies :: a -> m [FontFamily]
contextListFamilies context :: a
context = IO [FontFamily] -> m [FontFamily]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FontFamily] -> m [FontFamily])
-> IO [FontFamily] -> m [FontFamily]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr (Ptr (Ptr FontFamily))
families <- IO (Ptr (Ptr (Ptr FontFamily)))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr (Ptr Pango.FontFamily.FontFamily)))
    Ptr Int32
nFamilies <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Context -> Ptr (Ptr (Ptr FontFamily)) -> Ptr Int32 -> IO ()
pango_context_list_families Ptr Context
context' Ptr (Ptr (Ptr FontFamily))
families Ptr Int32
nFamilies
    Int32
nFamilies' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
nFamilies
    Ptr (Ptr FontFamily)
families' <- Ptr (Ptr (Ptr FontFamily)) -> IO (Ptr (Ptr FontFamily))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr FontFamily))
families
    [Ptr FontFamily]
families'' <- (Int32 -> Ptr (Ptr FontFamily) -> IO [Ptr FontFamily]
forall a b. Integral a => a -> Ptr (Ptr b) -> IO [Ptr b]
unpackPtrArrayWithLength Int32
nFamilies') Ptr (Ptr FontFamily)
families'
    [FontFamily]
families''' <- (Ptr FontFamily -> IO FontFamily)
-> [Ptr FontFamily] -> IO [FontFamily]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr FontFamily -> FontFamily)
-> Ptr FontFamily -> IO FontFamily
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr FontFamily -> FontFamily
Pango.FontFamily.FontFamily) [Ptr FontFamily]
families''
    Ptr (Ptr FontFamily) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr FontFamily)
families'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Ptr (Ptr (Ptr FontFamily)) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (Ptr FontFamily))
families
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
nFamilies
    [FontFamily] -> IO [FontFamily]
forall (m :: * -> *) a. Monad m => a -> m a
return [FontFamily]
families'''

#if defined(ENABLE_OVERLOADING)
data ContextListFamiliesMethodInfo
instance (signature ~ (m ([Pango.FontFamily.FontFamily])), MonadIO m, IsContext a) => O.MethodInfo ContextListFamiliesMethodInfo a signature where
    overloadedMethod = contextListFamilies

#endif

-- method Context::load_font
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #PangoFontDescription describing the font to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Font" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_load_font" pango_context_load_font :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    Ptr Pango.FontDescription.FontDescription -> -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO (Ptr Pango.Font.Font)

-- | Loads the font in one of the fontmaps in the context
-- that is the closest match for /@desc@/.
contextLoadFont ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> Pango.FontDescription.FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription' describing the font to load
    -> m (Maybe Pango.Font.Font)
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Objects.Font.Font'
    --          that was loaded, or 'P.Nothing' if no font matched.
contextLoadFont :: a -> FontDescription -> m (Maybe Font)
contextLoadFont context :: a
context desc :: FontDescription
desc = IO (Maybe Font) -> m (Maybe Font)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Font) -> m (Maybe Font))
-> IO (Maybe Font) -> m (Maybe Font)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Ptr Font
result <- Ptr Context -> Ptr FontDescription -> IO (Ptr Font)
pango_context_load_font Ptr Context
context' Ptr FontDescription
desc'
    Maybe Font
maybeResult <- Ptr Font -> (Ptr Font -> IO Font) -> IO (Maybe Font)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Font
result ((Ptr Font -> IO Font) -> IO (Maybe Font))
-> (Ptr Font -> IO Font) -> IO (Maybe Font)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Font
result' -> do
        Font
result'' <- ((ManagedPtr Font -> Font) -> Ptr Font -> IO Font
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Font -> Font
Pango.Font.Font) Ptr Font
result'
        Font -> IO Font
forall (m :: * -> *) a. Monad m => a -> m a
return Font
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Maybe Font -> IO (Maybe Font)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Font
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContextLoadFontMethodInfo
instance (signature ~ (Pango.FontDescription.FontDescription -> m (Maybe Pango.Font.Font)), MonadIO m, IsContext a) => O.MethodInfo ContextLoadFontMethodInfo a signature where
    overloadedMethod = contextLoadFont

#endif

-- method Context::load_fontset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #PangoFontDescription describing the fonts to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "language"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Language" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoLanguage the fonts will be used for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Fontset" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_load_fontset" pango_context_load_fontset :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    Ptr Pango.FontDescription.FontDescription -> -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Ptr Pango.Language.Language ->          -- language : TInterface (Name {namespace = "Pango", name = "Language"})
    IO (Ptr Pango.Fontset.Fontset)

-- | Load a set of fonts in the context that can be used to render
-- a font matching /@desc@/.
contextLoadFontset ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> Pango.FontDescription.FontDescription
    -- ^ /@desc@/: a t'GI.Pango.Structs.FontDescription.FontDescription' describing the fonts to load
    -> Pango.Language.Language
    -- ^ /@language@/: a t'GI.Pango.Structs.Language.Language' the fonts will be used for
    -> m (Maybe Pango.Fontset.Fontset)
    -- ^ __Returns:__ the newly allocated
    --          t'GI.Pango.Objects.Fontset.Fontset' loaded, or 'P.Nothing' if no font matched.
contextLoadFontset :: a -> FontDescription -> Language -> m (Maybe Fontset)
contextLoadFontset context :: a
context desc :: FontDescription
desc language :: Language
language = IO (Maybe Fontset) -> m (Maybe Fontset)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Fontset) -> m (Maybe Fontset))
-> IO (Maybe Fontset) -> m (Maybe Fontset)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Ptr Language
language' <- Language -> IO (Ptr Language)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Language
language
    Ptr Fontset
result <- Ptr Context
-> Ptr FontDescription -> Ptr Language -> IO (Ptr Fontset)
pango_context_load_fontset Ptr Context
context' Ptr FontDescription
desc' Ptr Language
language'
    Maybe Fontset
maybeResult <- Ptr Fontset -> (Ptr Fontset -> IO Fontset) -> IO (Maybe Fontset)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Fontset
result ((Ptr Fontset -> IO Fontset) -> IO (Maybe Fontset))
-> (Ptr Fontset -> IO Fontset) -> IO (Maybe Fontset)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Fontset
result' -> do
        Fontset
result'' <- ((ManagedPtr Fontset -> Fontset) -> Ptr Fontset -> IO Fontset
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Fontset -> Fontset
Pango.Fontset.Fontset) Ptr Fontset
result'
        Fontset -> IO Fontset
forall (m :: * -> *) a. Monad m => a -> m a
return Fontset
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    Language -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Language
language
    Maybe Fontset -> IO (Maybe Fontset)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Fontset
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContextLoadFontsetMethodInfo
instance (signature ~ (Pango.FontDescription.FontDescription -> Pango.Language.Language -> m (Maybe Pango.Fontset.Fontset)), MonadIO m, IsContext a) => O.MethodInfo ContextLoadFontsetMethodInfo a signature where
    overloadedMethod = contextLoadFontset

#endif

-- method Context::set_base_dir
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Direction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new base direction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_set_base_dir" pango_context_set_base_dir :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    CUInt ->                                -- direction : TInterface (Name {namespace = "Pango", name = "Direction"})
    IO ()

-- | Sets the base direction for the context.
-- 
-- The base direction is used in applying the Unicode bidirectional
-- algorithm; if the /@direction@/ is 'GI.Pango.Enums.DirectionLtr' or
-- 'GI.Pango.Enums.DirectionRtl', then the value will be used as the paragraph
-- direction in the Unicode bidirectional algorithm.  A value of
-- 'GI.Pango.Enums.DirectionWeakLtr' or 'GI.Pango.Enums.DirectionWeakRtl' is used only
-- for paragraphs that do not contain any strong characters themselves.
contextSetBaseDir ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> Pango.Enums.Direction
    -- ^ /@direction@/: the new base direction
    -> m ()
contextSetBaseDir :: a -> Direction -> m ()
contextSetBaseDir context :: a
context direction :: Direction
direction = 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 Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Direction -> Int) -> Direction -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> Int
forall a. Enum a => a -> Int
fromEnum) Direction
direction
    Ptr Context -> CUInt -> IO ()
pango_context_set_base_dir Ptr Context
context' CUInt
direction'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextSetBaseDirMethodInfo
instance (signature ~ (Pango.Enums.Direction -> m ()), MonadIO m, IsContext a) => O.MethodInfo ContextSetBaseDirMethodInfo a signature where
    overloadedMethod = contextSetBaseDir

#endif

-- method Context::set_base_gravity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gravity"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Gravity" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new base gravity"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_set_base_gravity" pango_context_set_base_gravity :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    CUInt ->                                -- gravity : TInterface (Name {namespace = "Pango", name = "Gravity"})
    IO ()

-- | Sets the base gravity for the context.
-- 
-- The base gravity is used in laying vertical text out.
-- 
-- /Since: 1.16/
contextSetBaseGravity ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> Pango.Enums.Gravity
    -- ^ /@gravity@/: the new base gravity
    -> m ()
contextSetBaseGravity :: a -> Gravity -> m ()
contextSetBaseGravity context :: a
context gravity :: Gravity
gravity = 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 Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let gravity' :: CUInt
gravity' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Gravity -> Int) -> Gravity -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
gravity
    Ptr Context -> CUInt -> IO ()
pango_context_set_base_gravity Ptr Context
context' CUInt
gravity'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextSetBaseGravityMethodInfo
instance (signature ~ (Pango.Enums.Gravity -> m ()), MonadIO m, IsContext a) => O.MethodInfo ContextSetBaseGravityMethodInfo a signature where
    overloadedMethod = contextSetBaseGravity

#endif

-- method Context::set_font_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new pango font description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_set_font_description" pango_context_set_font_description :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    Ptr Pango.FontDescription.FontDescription -> -- desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    IO ()

-- | Set the default font description for the context
contextSetFontDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> Pango.FontDescription.FontDescription
    -- ^ /@desc@/: the new pango font description
    -> m ()
contextSetFontDescription :: a -> FontDescription -> m ()
contextSetFontDescription context :: a
context desc :: FontDescription
desc = 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 Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr FontDescription
desc' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
desc
    Ptr Context -> Ptr FontDescription -> IO ()
pango_context_set_font_description Ptr Context
context' Ptr FontDescription
desc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontDescription
desc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextSetFontDescriptionMethodInfo
instance (signature ~ (Pango.FontDescription.FontDescription -> m ()), MonadIO m, IsContext a) => O.MethodInfo ContextSetFontDescriptionMethodInfo a signature where
    overloadedMethod = contextSetFontDescription

#endif

-- method Context::set_font_map
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "font_map"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontMap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #PangoFontMap to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_set_font_map" pango_context_set_font_map :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    Ptr Pango.FontMap.FontMap ->            -- font_map : TInterface (Name {namespace = "Pango", name = "FontMap"})
    IO ()

-- | Sets the font map to be searched when fonts are looked-up in this context.
-- This is only for internal use by Pango backends, a t'GI.Pango.Objects.Context.Context' obtained
-- via one of the recommended methods should already have a suitable font map.
contextSetFontMap ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a, Pango.FontMap.IsFontMap b) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> b
    -- ^ /@fontMap@/: the t'GI.Pango.Objects.FontMap.FontMap' to set.
    -> m ()
contextSetFontMap :: a -> b -> m ()
contextSetFontMap context :: a
context fontMap :: b
fontMap = 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 Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr FontMap
fontMap' <- b -> IO (Ptr FontMap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
fontMap
    Ptr Context -> Ptr FontMap -> IO ()
pango_context_set_font_map Ptr Context
context' Ptr FontMap
fontMap'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
fontMap
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextSetFontMapMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContext a, Pango.FontMap.IsFontMap b) => O.MethodInfo ContextSetFontMapMethodInfo a signature where
    overloadedMethod = contextSetFontMap

#endif

-- method Context::set_gravity_hint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hint"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GravityHint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new gravity hint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_set_gravity_hint" pango_context_set_gravity_hint :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    CUInt ->                                -- hint : TInterface (Name {namespace = "Pango", name = "GravityHint"})
    IO ()

-- | Sets the gravity hint for the context.
-- 
-- The gravity hint is used in laying vertical text out, and is only relevant
-- if gravity of the context as returned by 'GI.Pango.Objects.Context.contextGetGravity'
-- is set 'GI.Pango.Enums.GravityEast' or 'GI.Pango.Enums.GravityWest'.
-- 
-- /Since: 1.16/
contextSetGravityHint ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> Pango.Enums.GravityHint
    -- ^ /@hint@/: the new gravity hint
    -> m ()
contextSetGravityHint :: a -> GravityHint -> m ()
contextSetGravityHint context :: a
context hint :: GravityHint
hint = 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 Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let hint' :: CUInt
hint' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (GravityHint -> Int) -> GravityHint -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GravityHint -> Int
forall a. Enum a => a -> Int
fromEnum) GravityHint
hint
    Ptr Context -> CUInt -> IO ()
pango_context_set_gravity_hint Ptr Context
context' CUInt
hint'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextSetGravityHintMethodInfo
instance (signature ~ (Pango.Enums.GravityHint -> m ()), MonadIO m, IsContext a) => O.MethodInfo ContextSetGravityHintMethodInfo a signature where
    overloadedMethod = contextSetGravityHint

#endif

-- method Context::set_language
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "language"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Language" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new language tag."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_set_language" pango_context_set_language :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    Ptr Pango.Language.Language ->          -- language : TInterface (Name {namespace = "Pango", name = "Language"})
    IO ()

-- | Sets the global language tag for the context.  The default language
-- for the locale of the running process can be found using
-- 'GI.Pango.Functions.languageGetDefault'.
contextSetLanguage ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> Pango.Language.Language
    -- ^ /@language@/: the new language tag.
    -> m ()
contextSetLanguage :: a -> Language -> m ()
contextSetLanguage context :: a
context language :: Language
language = 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 Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Language
language' <- Language -> IO (Ptr Language)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Language
language
    Ptr Context -> Ptr Language -> IO ()
pango_context_set_language Ptr Context
context' Ptr Language
language'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Language -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Language
language
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextSetLanguageMethodInfo
instance (signature ~ (Pango.Language.Language -> m ()), MonadIO m, IsContext a) => O.MethodInfo ContextSetLanguageMethodInfo a signature where
    overloadedMethod = contextSetLanguage

#endif

-- method Context::set_matrix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #PangoMatrix, or %NULL to unset any existing\nmatrix. (No matrix set is the same as setting the identity matrix.)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_context_set_matrix" pango_context_set_matrix :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    Ptr Pango.Matrix.Matrix ->              -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    IO ()

-- | Sets the transformation matrix that will be applied when rendering
-- with this context. Note that reported metrics are in the user space
-- coordinates before the application of the matrix, not device-space
-- coordinates after the application of the matrix. So, they don\'t scale
-- with the matrix, though they may change slightly for different
-- matrices, depending on how the text is fit to the pixel grid.
-- 
-- /Since: 1.6/
contextSetMatrix ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.Pango.Objects.Context.Context'
    -> Maybe (Pango.Matrix.Matrix)
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix', or 'P.Nothing' to unset any existing
    -- matrix. (No matrix set is the same as setting the identity matrix.)
    -> m ()
contextSetMatrix :: a -> Maybe Matrix -> m ()
contextSetMatrix context :: a
context matrix :: Maybe Matrix
matrix = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Matrix
maybeMatrix <- case Maybe Matrix
matrix of
        Nothing -> Ptr Matrix -> IO (Ptr Matrix)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Matrix
forall a. Ptr a
nullPtr
        Just jMatrix :: Matrix
jMatrix -> do
            Ptr Matrix
jMatrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
jMatrix
            Ptr Matrix -> IO (Ptr Matrix)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Matrix
jMatrix'
    Ptr Context -> Ptr Matrix -> IO ()
pango_context_set_matrix Ptr Context
context' Ptr Matrix
maybeMatrix
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe Matrix -> (Matrix -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Matrix
matrix Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextSetMatrixMethodInfo
instance (signature ~ (Maybe (Pango.Matrix.Matrix) -> m ()), MonadIO m, IsContext a) => O.MethodInfo ContextSetMatrixMethodInfo a signature where
    overloadedMethod = contextSetMatrix

#endif