{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GtkFontDialog@ object collects the arguments that
-- are needed to present a font chooser dialog to the
-- user, such as a title for the dialog and whether it
-- should be modal.
-- 
-- The dialog is shown with the 'GI.Gtk.Objects.FontDialog.fontDialogChooseFont'
-- function or its variants. This API follows the GIO async pattern,
-- and the result can be obtained by calling the corresponding
-- finish function, such as 'GI.Gtk.Objects.FontDialog.fontDialogChooseFontFinish'.
-- 
-- See t'GI.Gtk.Objects.FontDialogButton.FontDialogButton' for a convenient control
-- that uses @GtkFontDialog@ and presents the results.
-- 
-- /Since: 4.10/

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

module GI.Gtk.Objects.FontDialog
    ( 
#if defined(ENABLE_OVERLOADING)
    FontDialogChooseFontAndFeaturesFinishMethodInfo,
#endif

-- * Exported types
    FontDialog(..)                          ,
    IsFontDialog                            ,
    toFontDialog                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [chooseFace]("GI.Gtk.Objects.FontDialog#g:method:chooseFace"), [chooseFaceFinish]("GI.Gtk.Objects.FontDialog#g:method:chooseFaceFinish"), [chooseFamily]("GI.Gtk.Objects.FontDialog#g:method:chooseFamily"), [chooseFamilyFinish]("GI.Gtk.Objects.FontDialog#g:method:chooseFamilyFinish"), [chooseFont]("GI.Gtk.Objects.FontDialog#g:method:chooseFont"), [chooseFontAndFeatures]("GI.Gtk.Objects.FontDialog#g:method:chooseFontAndFeatures"), [chooseFontAndFeaturesFinish]("GI.Gtk.Objects.FontDialog#g:method:chooseFontAndFeaturesFinish"), [chooseFontFinish]("GI.Gtk.Objects.FontDialog#g:method:chooseFontFinish"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFilter]("GI.Gtk.Objects.FontDialog#g:method:getFilter"), [getFontMap]("GI.Gtk.Objects.FontDialog#g:method:getFontMap"), [getLanguage]("GI.Gtk.Objects.FontDialog#g:method:getLanguage"), [getModal]("GI.Gtk.Objects.FontDialog#g:method:getModal"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTitle]("GI.Gtk.Objects.FontDialog#g:method:getTitle").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFilter]("GI.Gtk.Objects.FontDialog#g:method:setFilter"), [setFontMap]("GI.Gtk.Objects.FontDialog#g:method:setFontMap"), [setLanguage]("GI.Gtk.Objects.FontDialog#g:method:setLanguage"), [setModal]("GI.Gtk.Objects.FontDialog#g:method:setModal"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTitle]("GI.Gtk.Objects.FontDialog#g:method:setTitle").

#if defined(ENABLE_OVERLOADING)
    ResolveFontDialogMethod                 ,
#endif

-- ** chooseFace #method:chooseFace#

#if defined(ENABLE_OVERLOADING)
    FontDialogChooseFaceMethodInfo          ,
#endif
    fontDialogChooseFace                    ,


-- ** chooseFaceFinish #method:chooseFaceFinish#

#if defined(ENABLE_OVERLOADING)
    FontDialogChooseFaceFinishMethodInfo    ,
#endif
    fontDialogChooseFaceFinish              ,


-- ** chooseFamily #method:chooseFamily#

#if defined(ENABLE_OVERLOADING)
    FontDialogChooseFamilyMethodInfo        ,
#endif
    fontDialogChooseFamily                  ,


-- ** chooseFamilyFinish #method:chooseFamilyFinish#

#if defined(ENABLE_OVERLOADING)
    FontDialogChooseFamilyFinishMethodInfo  ,
#endif
    fontDialogChooseFamilyFinish            ,


-- ** chooseFont #method:chooseFont#

#if defined(ENABLE_OVERLOADING)
    FontDialogChooseFontMethodInfo          ,
#endif
    fontDialogChooseFont                    ,


-- ** chooseFontAndFeatures #method:chooseFontAndFeatures#

#if defined(ENABLE_OVERLOADING)
    FontDialogChooseFontAndFeaturesMethodInfo,
#endif
    fontDialogChooseFontAndFeatures         ,


-- ** chooseFontFinish #method:chooseFontFinish#

#if defined(ENABLE_OVERLOADING)
    FontDialogChooseFontFinishMethodInfo    ,
#endif
    fontDialogChooseFontFinish              ,


-- ** getFilter #method:getFilter#

#if defined(ENABLE_OVERLOADING)
    FontDialogGetFilterMethodInfo           ,
#endif
    fontDialogGetFilter                     ,


-- ** getFontMap #method:getFontMap#

#if defined(ENABLE_OVERLOADING)
    FontDialogGetFontMapMethodInfo          ,
#endif
    fontDialogGetFontMap                    ,


-- ** getLanguage #method:getLanguage#

#if defined(ENABLE_OVERLOADING)
    FontDialogGetLanguageMethodInfo         ,
#endif
    fontDialogGetLanguage                   ,


-- ** getModal #method:getModal#

#if defined(ENABLE_OVERLOADING)
    FontDialogGetModalMethodInfo            ,
#endif
    fontDialogGetModal                      ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    FontDialogGetTitleMethodInfo            ,
#endif
    fontDialogGetTitle                      ,


-- ** new #method:new#

    fontDialogNew                           ,


-- ** setFilter #method:setFilter#

#if defined(ENABLE_OVERLOADING)
    FontDialogSetFilterMethodInfo           ,
#endif
    fontDialogSetFilter                     ,


-- ** setFontMap #method:setFontMap#

#if defined(ENABLE_OVERLOADING)
    FontDialogSetFontMapMethodInfo          ,
#endif
    fontDialogSetFontMap                    ,


-- ** setLanguage #method:setLanguage#

#if defined(ENABLE_OVERLOADING)
    FontDialogSetLanguageMethodInfo         ,
#endif
    fontDialogSetLanguage                   ,


-- ** setModal #method:setModal#

#if defined(ENABLE_OVERLOADING)
    FontDialogSetModalMethodInfo            ,
#endif
    fontDialogSetModal                      ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    FontDialogSetTitleMethodInfo            ,
#endif
    fontDialogSetTitle                      ,




 -- * Properties


-- ** filter #attr:filter#
-- | Sets a filter to restrict what fonts are shown
-- in the font chooser dialog.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FontDialogFilterPropertyInfo            ,
#endif
    clearFontDialogFilter                   ,
    constructFontDialogFilter               ,
#if defined(ENABLE_OVERLOADING)
    fontDialogFilter                        ,
#endif
    getFontDialogFilter                     ,
    setFontDialogFilter                     ,


-- ** fontMap #attr:fontMap#
-- | Sets a custom font map to select fonts from.
-- 
-- A custom font map can be used to present application-specific
-- fonts instead of or in addition to the normal system fonts.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FontDialogFontMapPropertyInfo           ,
#endif
    clearFontDialogFontMap                  ,
    constructFontDialogFontMap              ,
#if defined(ENABLE_OVERLOADING)
    fontDialogFontMap                       ,
#endif
    getFontDialogFontMap                    ,
    setFontDialogFontMap                    ,


-- ** language #attr:language#
-- | The language for which the font features are selected.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FontDialogLanguagePropertyInfo          ,
#endif
    constructFontDialogLanguage             ,
#if defined(ENABLE_OVERLOADING)
    fontDialogLanguage                      ,
#endif
    getFontDialogLanguage                   ,
    setFontDialogLanguage                   ,


-- ** modal #attr:modal#
-- | Whether the font chooser dialog is modal.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FontDialogModalPropertyInfo             ,
#endif
    constructFontDialogModal                ,
#if defined(ENABLE_OVERLOADING)
    fontDialogModal                         ,
#endif
    getFontDialogModal                      ,
    setFontDialogModal                      ,


-- ** title #attr:title#
-- | A title that may be shown on the font chooser
-- dialog that is presented by 'GI.Gtk.Objects.FontDialog.fontDialogChooseFont'.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FontDialogTitlePropertyInfo             ,
#endif
    constructFontDialogTitle                ,
#if defined(ENABLE_OVERLOADING)
    fontDialogTitle                         ,
#endif
    getFontDialogTitle                      ,
    setFontDialogTitle                      ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Filter as Gtk.Filter
import {-# SOURCE #-} qualified GI.Gtk.Objects.Window as Gtk.Window
import qualified GI.Pango.Objects.FontFace as Pango.FontFace
import qualified GI.Pango.Objects.FontFamily as Pango.FontFamily
import qualified GI.Pango.Objects.FontMap as Pango.FontMap
import qualified GI.Pango.Structs.FontDescription as Pango.FontDescription
import qualified GI.Pango.Structs.Language as Pango.Language

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

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

foreign import ccall "gtk_font_dialog_get_type"
    c_gtk_font_dialog_get_type :: IO B.Types.GType

instance B.Types.TypedObject FontDialog where
    glibType :: IO GType
glibType = IO GType
c_gtk_font_dialog_get_type

instance B.Types.GObject FontDialog

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveFontDialogMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveFontDialogMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFontDialogMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFontDialogMethod "chooseFace" o = FontDialogChooseFaceMethodInfo
    ResolveFontDialogMethod "chooseFaceFinish" o = FontDialogChooseFaceFinishMethodInfo
    ResolveFontDialogMethod "chooseFamily" o = FontDialogChooseFamilyMethodInfo
    ResolveFontDialogMethod "chooseFamilyFinish" o = FontDialogChooseFamilyFinishMethodInfo
    ResolveFontDialogMethod "chooseFont" o = FontDialogChooseFontMethodInfo
    ResolveFontDialogMethod "chooseFontAndFeatures" o = FontDialogChooseFontAndFeaturesMethodInfo
    ResolveFontDialogMethod "chooseFontAndFeaturesFinish" o = FontDialogChooseFontAndFeaturesFinishMethodInfo
    ResolveFontDialogMethod "chooseFontFinish" o = FontDialogChooseFontFinishMethodInfo
    ResolveFontDialogMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFontDialogMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFontDialogMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFontDialogMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFontDialogMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFontDialogMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFontDialogMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFontDialogMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFontDialogMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFontDialogMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFontDialogMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFontDialogMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFontDialogMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFontDialogMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFontDialogMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFontDialogMethod "getFilter" o = FontDialogGetFilterMethodInfo
    ResolveFontDialogMethod "getFontMap" o = FontDialogGetFontMapMethodInfo
    ResolveFontDialogMethod "getLanguage" o = FontDialogGetLanguageMethodInfo
    ResolveFontDialogMethod "getModal" o = FontDialogGetModalMethodInfo
    ResolveFontDialogMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFontDialogMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFontDialogMethod "getTitle" o = FontDialogGetTitleMethodInfo
    ResolveFontDialogMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFontDialogMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFontDialogMethod "setFilter" o = FontDialogSetFilterMethodInfo
    ResolveFontDialogMethod "setFontMap" o = FontDialogSetFontMapMethodInfo
    ResolveFontDialogMethod "setLanguage" o = FontDialogSetLanguageMethodInfo
    ResolveFontDialogMethod "setModal" o = FontDialogSetModalMethodInfo
    ResolveFontDialogMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFontDialogMethod "setTitle" o = FontDialogSetTitleMethodInfo
    ResolveFontDialogMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif

-- VVV Prop "filter"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Filter"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

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

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

-- | Set the value of the “@filter@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #filter
-- @
clearFontDialogFilter :: (MonadIO m, IsFontDialog o) => o -> m ()
clearFontDialogFilter :: forall (m :: * -> *) o. (MonadIO m, IsFontDialog o) => o -> m ()
clearFontDialogFilter o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Filter -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"filter" (Maybe Filter
forall a. Maybe a
Nothing :: Maybe Gtk.Filter.Filter)

#if defined(ENABLE_OVERLOADING)
data FontDialogFilterPropertyInfo
instance AttrInfo FontDialogFilterPropertyInfo where
    type AttrAllowedOps FontDialogFilterPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FontDialogFilterPropertyInfo = IsFontDialog
    type AttrSetTypeConstraint FontDialogFilterPropertyInfo = Gtk.Filter.IsFilter
    type AttrTransferTypeConstraint FontDialogFilterPropertyInfo = Gtk.Filter.IsFilter
    type AttrTransferType FontDialogFilterPropertyInfo = Gtk.Filter.Filter
    type AttrGetType FontDialogFilterPropertyInfo = (Maybe Gtk.Filter.Filter)
    type AttrLabel FontDialogFilterPropertyInfo = "filter"
    type AttrOrigin FontDialogFilterPropertyInfo = FontDialog
    attrGet = getFontDialogFilter
    attrSet = setFontDialogFilter
    attrTransfer _ v = do
        unsafeCastTo Gtk.Filter.Filter v
    attrConstruct = constructFontDialogFilter
    attrClear = clearFontDialogFilter
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.filter"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#g:attr:filter"
        })
#endif

-- VVV Prop "font-map"
   -- Type: TInterface (Name {namespace = "Pango", name = "FontMap"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@font-map@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' fontDialog #fontMap
-- @
getFontDialogFontMap :: (MonadIO m, IsFontDialog o) => o -> m (Maybe Pango.FontMap.FontMap)
getFontDialogFontMap :: forall (m :: * -> *) o.
(MonadIO m, IsFontDialog o) =>
o -> m (Maybe FontMap)
getFontDialogFontMap o
obj = IO (Maybe FontMap) -> m (Maybe FontMap)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe FontMap) -> m (Maybe FontMap))
-> IO (Maybe FontMap) -> m (Maybe FontMap)
forall a b. (a -> b) -> a -> b
$ o
-> String -> (ManagedPtr FontMap -> FontMap) -> IO (Maybe FontMap)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"font-map" ManagedPtr FontMap -> FontMap
Pango.FontMap.FontMap

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

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

-- | Set the value of the “@font-map@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #fontMap
-- @
clearFontDialogFontMap :: (MonadIO m, IsFontDialog o) => o -> m ()
clearFontDialogFontMap :: forall (m :: * -> *) o. (MonadIO m, IsFontDialog o) => o -> m ()
clearFontDialogFontMap o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe FontMap -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"font-map" (Maybe FontMap
forall a. Maybe a
Nothing :: Maybe Pango.FontMap.FontMap)

#if defined(ENABLE_OVERLOADING)
data FontDialogFontMapPropertyInfo
instance AttrInfo FontDialogFontMapPropertyInfo where
    type AttrAllowedOps FontDialogFontMapPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FontDialogFontMapPropertyInfo = IsFontDialog
    type AttrSetTypeConstraint FontDialogFontMapPropertyInfo = Pango.FontMap.IsFontMap
    type AttrTransferTypeConstraint FontDialogFontMapPropertyInfo = Pango.FontMap.IsFontMap
    type AttrTransferType FontDialogFontMapPropertyInfo = Pango.FontMap.FontMap
    type AttrGetType FontDialogFontMapPropertyInfo = (Maybe Pango.FontMap.FontMap)
    type AttrLabel FontDialogFontMapPropertyInfo = "font-map"
    type AttrOrigin FontDialogFontMapPropertyInfo = FontDialog
    attrGet = getFontDialogFontMap
    attrSet = setFontDialogFontMap
    attrTransfer _ v = do
        unsafeCastTo Pango.FontMap.FontMap v
    attrConstruct = constructFontDialogFontMap
    attrClear = clearFontDialogFontMap
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontMap"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#g:attr:fontMap"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data FontDialogLanguagePropertyInfo
instance AttrInfo FontDialogLanguagePropertyInfo where
    type AttrAllowedOps FontDialogLanguagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FontDialogLanguagePropertyInfo = IsFontDialog
    type AttrSetTypeConstraint FontDialogLanguagePropertyInfo = (~) Pango.Language.Language
    type AttrTransferTypeConstraint FontDialogLanguagePropertyInfo = (~) Pango.Language.Language
    type AttrTransferType FontDialogLanguagePropertyInfo = Pango.Language.Language
    type AttrGetType FontDialogLanguagePropertyInfo = (Maybe Pango.Language.Language)
    type AttrLabel FontDialogLanguagePropertyInfo = "language"
    type AttrOrigin FontDialogLanguagePropertyInfo = FontDialog
    attrGet = getFontDialogLanguage
    attrSet = setFontDialogLanguage
    attrTransfer _ v = do
        return v
    attrConstruct = constructFontDialogLanguage
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.language"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#g:attr:language"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data FontDialogModalPropertyInfo
instance AttrInfo FontDialogModalPropertyInfo where
    type AttrAllowedOps FontDialogModalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FontDialogModalPropertyInfo = IsFontDialog
    type AttrSetTypeConstraint FontDialogModalPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint FontDialogModalPropertyInfo = (~) Bool
    type AttrTransferType FontDialogModalPropertyInfo = Bool
    type AttrGetType FontDialogModalPropertyInfo = Bool
    type AttrLabel FontDialogModalPropertyInfo = "modal"
    type AttrOrigin FontDialogModalPropertyInfo = FontDialog
    attrGet = getFontDialogModal
    attrSet = setFontDialogModal
    attrTransfer _ v = do
        return v
    attrConstruct = constructFontDialogModal
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.modal"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#g:attr:modal"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data FontDialogTitlePropertyInfo
instance AttrInfo FontDialogTitlePropertyInfo where
    type AttrAllowedOps FontDialogTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FontDialogTitlePropertyInfo = IsFontDialog
    type AttrSetTypeConstraint FontDialogTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint FontDialogTitlePropertyInfo = (~) T.Text
    type AttrTransferType FontDialogTitlePropertyInfo = T.Text
    type AttrGetType FontDialogTitlePropertyInfo = T.Text
    type AttrLabel FontDialogTitlePropertyInfo = "title"
    type AttrOrigin FontDialogTitlePropertyInfo = FontDialog
    attrGet = getFontDialogTitle
    attrSet = setFontDialogTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructFontDialogTitle
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#g:attr:title"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FontDialog
type instance O.AttributeList FontDialog = FontDialogAttributeList
type FontDialogAttributeList = ('[ '("filter", FontDialogFilterPropertyInfo), '("fontMap", FontDialogFontMapPropertyInfo), '("language", FontDialogLanguagePropertyInfo), '("modal", FontDialogModalPropertyInfo), '("title", FontDialogTitlePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
fontDialogFilter :: AttrLabelProxy "filter"
fontDialogFilter = AttrLabelProxy

fontDialogFontMap :: AttrLabelProxy "fontMap"
fontDialogFontMap = AttrLabelProxy

fontDialogLanguage :: AttrLabelProxy "language"
fontDialogLanguage = AttrLabelProxy

fontDialogModal :: AttrLabelProxy "modal"
fontDialogModal = AttrLabelProxy

fontDialogTitle :: AttrLabelProxy "title"
fontDialogTitle = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList FontDialog = FontDialogSignalList
type FontDialogSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "gtk_font_dialog_new" gtk_font_dialog_new :: 
    IO (Ptr FontDialog)

-- | Creates a new @GtkFontDialog@ object.
-- 
-- /Since: 4.10/
fontDialogNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m FontDialog
    -- ^ __Returns:__ the new @GtkFontDialog@
fontDialogNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m FontDialog
fontDialogNew  = IO FontDialog -> m FontDialog
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontDialog -> m FontDialog) -> IO FontDialog -> m FontDialog
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
result <- IO (Ptr FontDialog)
gtk_font_dialog_new
    Text -> Ptr FontDialog -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontDialogNew" Ptr FontDialog
result
    FontDialog
result' <- ((ManagedPtr FontDialog -> FontDialog)
-> Ptr FontDialog -> IO FontDialog
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FontDialog -> FontDialog
FontDialog) Ptr FontDialog
result
    FontDialog -> IO FontDialog
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FontDialog
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FontDialog::choose_face
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent `GtkWindow`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "initial_value"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontFace" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the initial value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GCancellable` to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_choose_face" gtk_font_dialog_choose_face :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Pango.FontFace.FontFace ->          -- initial_value : TInterface (Name {namespace = "Pango", name = "FontFace"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | This function initiates a font selection operation by
-- presenting a dialog to the user for selecting a font face
-- (i.e. a font family and style, but not a specific font size).
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- It should call 'GI.Gtk.Objects.FontDialog.fontDialogChooseFaceFinish'
-- to obtain the result.
-- 
-- /Since: 4.10/
fontDialogChooseFace ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gtk.Window.IsWindow b, Pango.FontFace.IsFontFace c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> Maybe (b)
    -- ^ /@parent@/: the parent @GtkWindow@
    -> Maybe (c)
    -- ^ /@initialValue@/: the initial value
    -> Maybe (d)
    -- ^ /@cancellable@/: a @GCancellable@ to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the operation is complete
    -> m ()
fontDialogChooseFace :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsFontDialog a, IsWindow b, IsFontFace c,
 IsCancellable d) =>
a
-> Maybe b
-> Maybe c
-> Maybe d
-> Maybe AsyncReadyCallback
-> m ()
fontDialogChooseFace a
self Maybe b
parent Maybe c
initialValue Maybe d
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr FontFace
maybeInitialValue <- case Maybe c
initialValue of
        Maybe c
Nothing -> Ptr FontFace -> IO (Ptr FontFace)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontFace
forall a. Ptr a
nullPtr
        Just c
jInitialValue -> do
            Ptr FontFace
jInitialValue' <- c -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jInitialValue
            Ptr FontFace -> IO (Ptr FontFace)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontFace
jInitialValue'
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Maybe d
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FontDialog
-> Ptr Window
-> Ptr FontFace
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_font_dialog_choose_face Ptr FontDialog
self' Ptr Window
maybeParent Ptr FontFace
maybeInitialValue Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
initialValue c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDialogChooseFaceMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (d) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFontDialog a, Gtk.Window.IsWindow b, Pango.FontFace.IsFontFace c, Gio.Cancellable.IsCancellable d) => O.OverloadedMethod FontDialogChooseFaceMethodInfo a signature where
    overloadedMethod = fontDialogChooseFace

instance O.OverloadedMethodInfo FontDialogChooseFaceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogChooseFace",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogChooseFace"
        })


#endif

-- method FontDialog::choose_face_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GAsyncResult`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "FontFace" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_font_dialog_choose_face_finish" gtk_font_dialog_choose_face_finish :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Pango.FontFace.FontFace)

-- | Finishes the 'GI.Gtk.Objects.FontDialog.fontDialogChooseFace' call
-- and returns the resulting font face.
-- 
-- /Since: 4.10/
fontDialogChooseFaceFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m (Maybe Pango.FontFace.FontFace)
    -- ^ __Returns:__ the selected font face /(Can throw 'Data.GI.Base.GError.GError')/
fontDialogChooseFaceFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFontDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe FontFace)
fontDialogChooseFaceFinish a
self b
result_ = IO (Maybe FontFace) -> m (Maybe FontFace)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FontFace) -> m (Maybe FontFace))
-> IO (Maybe FontFace) -> m (Maybe FontFace)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO (Maybe FontFace) -> IO () -> IO (Maybe FontFace)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FontFace
result <- (Ptr (Ptr GError) -> IO (Ptr FontFace)) -> IO (Ptr FontFace)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FontFace)) -> IO (Ptr FontFace))
-> (Ptr (Ptr GError) -> IO (Ptr FontFace)) -> IO (Ptr FontFace)
forall a b. (a -> b) -> a -> b
$ Ptr FontDialog
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FontFace)
gtk_font_dialog_choose_face_finish Ptr FontDialog
self' Ptr AsyncResult
result_'
        Maybe FontFace
maybeResult <- Ptr FontFace
-> (Ptr FontFace -> IO FontFace) -> IO (Maybe FontFace)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FontFace
result ((Ptr FontFace -> IO FontFace) -> IO (Maybe FontFace))
-> (Ptr FontFace -> IO FontFace) -> IO (Maybe FontFace)
forall a b. (a -> b) -> a -> b
$ \Ptr FontFace
result' -> do
            FontFace
result'' <- ((ManagedPtr FontFace -> FontFace) -> Ptr FontFace -> IO FontFace
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FontFace -> FontFace
Pango.FontFace.FontFace) Ptr FontFace
result'
            FontFace -> IO FontFace
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FontFace
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Maybe FontFace -> IO (Maybe FontFace)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontFace
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FontDialogChooseFaceFinishMethodInfo
instance (signature ~ (b -> m (Maybe Pango.FontFace.FontFace)), MonadIO m, IsFontDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FontDialogChooseFaceFinishMethodInfo a signature where
    overloadedMethod = fontDialogChooseFaceFinish

instance O.OverloadedMethodInfo FontDialogChooseFaceFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogChooseFaceFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogChooseFaceFinish"
        })


#endif

-- method FontDialog::choose_family
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent `GtkWindow`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "initial_value"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontFamily" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the initial value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GCancellable` to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_choose_family" gtk_font_dialog_choose_family :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Pango.FontFamily.FontFamily ->      -- initial_value : TInterface (Name {namespace = "Pango", name = "FontFamily"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | This function initiates a font selection operation by
-- presenting a dialog to the user for selecting a font family.
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- It should call 'GI.Gtk.Objects.FontDialog.fontDialogChooseFamilyFinish'
-- to obtain the result.
-- 
-- /Since: 4.10/
fontDialogChooseFamily ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gtk.Window.IsWindow b, Pango.FontFamily.IsFontFamily c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> Maybe (b)
    -- ^ /@parent@/: the parent @GtkWindow@
    -> Maybe (c)
    -- ^ /@initialValue@/: the initial value
    -> Maybe (d)
    -- ^ /@cancellable@/: a @GCancellable@ to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the operation is complete
    -> m ()
fontDialogChooseFamily :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsFontDialog a, IsWindow b,
 IsFontFamily c, IsCancellable d) =>
a
-> Maybe b
-> Maybe c
-> Maybe d
-> Maybe AsyncReadyCallback
-> m ()
fontDialogChooseFamily a
self Maybe b
parent Maybe c
initialValue Maybe d
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr FontFamily
maybeInitialValue <- case Maybe c
initialValue of
        Maybe c
Nothing -> Ptr FontFamily -> IO (Ptr FontFamily)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontFamily
forall a. Ptr a
nullPtr
        Just c
jInitialValue -> do
            Ptr FontFamily
jInitialValue' <- c -> IO (Ptr FontFamily)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jInitialValue
            Ptr FontFamily -> IO (Ptr FontFamily)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontFamily
jInitialValue'
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Maybe d
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FontDialog
-> Ptr Window
-> Ptr FontFamily
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_font_dialog_choose_family Ptr FontDialog
self' Ptr Window
maybeParent Ptr FontFamily
maybeInitialValue Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
initialValue c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDialogChooseFamilyMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (d) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFontDialog a, Gtk.Window.IsWindow b, Pango.FontFamily.IsFontFamily c, Gio.Cancellable.IsCancellable d) => O.OverloadedMethod FontDialogChooseFamilyMethodInfo a signature where
    overloadedMethod = fontDialogChooseFamily

instance O.OverloadedMethodInfo FontDialogChooseFamilyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogChooseFamily",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogChooseFamily"
        })


#endif

-- method FontDialog::choose_family_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GAsyncResult`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Pango" , name = "FontFamily" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_font_dialog_choose_family_finish" gtk_font_dialog_choose_family_finish :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Pango.FontFamily.FontFamily)

-- | Finishes the 'GI.Gtk.Objects.FontDialog.fontDialogChooseFamily' call
-- and returns the resulting family.
-- 
-- This function never returns an error. If the operation is
-- not finished successfully, the value passed as /@initialValue@/
-- to 'GI.Gtk.Objects.FontDialog.fontDialogChooseFamily' is returned.
-- 
-- /Since: 4.10/
fontDialogChooseFamilyFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m (Maybe Pango.FontFamily.FontFamily)
    -- ^ __Returns:__ the selected family /(Can throw 'Data.GI.Base.GError.GError')/
fontDialogChooseFamilyFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFontDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe FontFamily)
fontDialogChooseFamilyFinish a
self b
result_ = IO (Maybe FontFamily) -> m (Maybe FontFamily)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FontFamily) -> m (Maybe FontFamily))
-> IO (Maybe FontFamily) -> m (Maybe FontFamily)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO (Maybe FontFamily) -> IO () -> IO (Maybe FontFamily)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FontFamily
result <- (Ptr (Ptr GError) -> IO (Ptr FontFamily)) -> IO (Ptr FontFamily)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FontFamily)) -> IO (Ptr FontFamily))
-> (Ptr (Ptr GError) -> IO (Ptr FontFamily)) -> IO (Ptr FontFamily)
forall a b. (a -> b) -> a -> b
$ Ptr FontDialog
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FontFamily)
gtk_font_dialog_choose_family_finish Ptr FontDialog
self' Ptr AsyncResult
result_'
        Maybe FontFamily
maybeResult <- Ptr FontFamily
-> (Ptr FontFamily -> IO FontFamily) -> IO (Maybe FontFamily)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FontFamily
result ((Ptr FontFamily -> IO FontFamily) -> IO (Maybe FontFamily))
-> (Ptr FontFamily -> IO FontFamily) -> IO (Maybe FontFamily)
forall a b. (a -> b) -> a -> b
$ \Ptr FontFamily
result' -> do
            FontFamily
result'' <- ((ManagedPtr FontFamily -> FontFamily)
-> Ptr FontFamily -> IO FontFamily
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FontFamily -> FontFamily
Pango.FontFamily.FontFamily) Ptr FontFamily
result'
            FontFamily -> IO FontFamily
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FontFamily
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Maybe FontFamily -> IO (Maybe FontFamily)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontFamily
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FontDialogChooseFamilyFinishMethodInfo
instance (signature ~ (b -> m (Maybe Pango.FontFamily.FontFamily)), MonadIO m, IsFontDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FontDialogChooseFamilyFinishMethodInfo a signature where
    overloadedMethod = fontDialogChooseFamilyFinish

instance O.OverloadedMethodInfo FontDialogChooseFamilyFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogChooseFamilyFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogChooseFamilyFinish"
        })


#endif

-- method FontDialog::choose_font
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent `GtkWindow`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "initial_value"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the font to select initially"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GCancellable` to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_choose_font" gtk_font_dialog_choose_font :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Pango.FontDescription.FontDescription -> -- initial_value : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | This function initiates a font selection operation by
-- presenting a dialog to the user for selecting a font.
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- It should call 'GI.Gtk.Objects.FontDialog.fontDialogChooseFontFinish'
-- to obtain the result.
-- 
-- If you want to let the user select font features as well,
-- use 'GI.Gtk.Objects.FontDialog.fontDialogChooseFontAndFeatures' instead.
-- 
-- /Since: 4.10/
fontDialogChooseFont ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> Maybe (b)
    -- ^ /@parent@/: the parent @GtkWindow@
    -> Maybe (Pango.FontDescription.FontDescription)
    -- ^ /@initialValue@/: the font to select initially
    -> Maybe (c)
    -- ^ /@cancellable@/: a @GCancellable@ to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the operation is complete
    -> m ()
fontDialogChooseFont :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFontDialog a, IsWindow b,
 IsCancellable c) =>
a
-> Maybe b
-> Maybe FontDescription
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
fontDialogChooseFont a
self Maybe b
parent Maybe FontDescription
initialValue Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr FontDescription
maybeInitialValue <- case Maybe FontDescription
initialValue of
        Maybe FontDescription
Nothing -> Ptr FontDescription -> IO (Ptr FontDescription)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontDescription
forall a. Ptr a
nullPtr
        Just FontDescription
jInitialValue -> do
            Ptr FontDescription
jInitialValue' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
jInitialValue
            Ptr FontDescription -> IO (Ptr FontDescription)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontDescription
jInitialValue'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FontDialog
-> Ptr Window
-> Ptr FontDescription
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_font_dialog_choose_font Ptr FontDialog
self' Ptr Window
maybeParent Ptr FontDescription
maybeInitialValue Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe FontDescription -> (FontDescription -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe FontDescription
initialValue FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDialogChooseFontMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Pango.FontDescription.FontDescription) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFontDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FontDialogChooseFontMethodInfo a signature where
    overloadedMethod = fontDialogChooseFont

instance O.OverloadedMethodInfo FontDialogChooseFontMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogChooseFont",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogChooseFont"
        })


#endif

-- method FontDialog::choose_font_and_features
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent `GtkWindow`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "initial_value"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the font to select initially"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GCancellable` to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_choose_font_and_features" gtk_font_dialog_choose_font_and_features :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Pango.FontDescription.FontDescription -> -- initial_value : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | This function initiates a font selection operation by
-- presenting a dialog to the user for selecting a font and
-- font features.
-- 
-- Font features affect how the font is rendered, for example
-- enabling glyph variants or ligatures.
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- It should call 'GI.Gtk.Objects.FontDialog.fontDialogChooseFontAndFeaturesFinish'
-- to obtain the result.
-- 
-- /Since: 4.10/
fontDialogChooseFontAndFeatures ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> Maybe (b)
    -- ^ /@parent@/: the parent @GtkWindow@
    -> Maybe (Pango.FontDescription.FontDescription)
    -- ^ /@initialValue@/: the font to select initially
    -> Maybe (c)
    -- ^ /@cancellable@/: a @GCancellable@ to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the operation is complete
    -> m ()
fontDialogChooseFontAndFeatures :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFontDialog a, IsWindow b,
 IsCancellable c) =>
a
-> Maybe b
-> Maybe FontDescription
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
fontDialogChooseFontAndFeatures a
self Maybe b
parent Maybe FontDescription
initialValue Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr FontDescription
maybeInitialValue <- case Maybe FontDescription
initialValue of
        Maybe FontDescription
Nothing -> Ptr FontDescription -> IO (Ptr FontDescription)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontDescription
forall a. Ptr a
nullPtr
        Just FontDescription
jInitialValue -> do
            Ptr FontDescription
jInitialValue' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
jInitialValue
            Ptr FontDescription -> IO (Ptr FontDescription)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontDescription
jInitialValue'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FontDialog
-> Ptr Window
-> Ptr FontDescription
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_font_dialog_choose_font_and_features Ptr FontDialog
self' Ptr Window
maybeParent Ptr FontDescription
maybeInitialValue Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe FontDescription -> (FontDescription -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe FontDescription
initialValue FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDialogChooseFontAndFeaturesMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Pango.FontDescription.FontDescription) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFontDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FontDialogChooseFontAndFeaturesMethodInfo a signature where
    overloadedMethod = fontDialogChooseFontAndFeatures

instance O.OverloadedMethodInfo FontDialogChooseFontAndFeaturesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogChooseFontAndFeatures",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogChooseFontAndFeatures"
        })


#endif

-- XXX Could not generate method FontDialog::choose_font_and_features_finish
-- Not implemented: Don't know how to allocate "font_desc" of type TInterface (Name {namespace = "Pango", name = "FontDescription"})
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data FontDialogChooseFontAndFeaturesFinishMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "chooseFontAndFeaturesFinish" FontDialog) => O.OverloadedMethod FontDialogChooseFontAndFeaturesFinishMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "chooseFontAndFeaturesFinish" FontDialog) => O.OverloadedMethodInfo FontDialogChooseFontAndFeaturesFinishMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- method FontDialog::choose_font_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GAsyncResult`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Pango" , name = "FontDescription" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_font_dialog_choose_font_finish" gtk_font_dialog_choose_font_finish :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Pango.FontDescription.FontDescription)

-- | Finishes the 'GI.Gtk.Objects.FontDialog.fontDialogChooseFont' call
-- and returns the resulting font description.
-- 
-- /Since: 4.10/
fontDialogChooseFontFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m (Maybe Pango.FontDescription.FontDescription)
    -- ^ __Returns:__ the selected font /(Can throw 'Data.GI.Base.GError.GError')/
fontDialogChooseFontFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFontDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe FontDescription)
fontDialogChooseFontFinish a
self b
result_ = IO (Maybe FontDescription) -> m (Maybe FontDescription)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FontDescription) -> m (Maybe FontDescription))
-> IO (Maybe FontDescription) -> m (Maybe FontDescription)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO (Maybe FontDescription) -> IO () -> IO (Maybe FontDescription)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FontDescription
result <- (Ptr (Ptr GError) -> IO (Ptr FontDescription))
-> IO (Ptr FontDescription)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FontDescription))
 -> IO (Ptr FontDescription))
-> (Ptr (Ptr GError) -> IO (Ptr FontDescription))
-> IO (Ptr FontDescription)
forall a b. (a -> b) -> a -> b
$ Ptr FontDialog
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FontDescription)
gtk_font_dialog_choose_font_finish Ptr FontDialog
self' Ptr AsyncResult
result_'
        Maybe FontDescription
maybeResult <- Ptr FontDescription
-> (Ptr FontDescription -> IO FontDescription)
-> IO (Maybe FontDescription)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FontDescription
result ((Ptr FontDescription -> IO FontDescription)
 -> IO (Maybe FontDescription))
-> (Ptr FontDescription -> IO FontDescription)
-> IO (Maybe FontDescription)
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
result' -> do
            FontDescription
result'' <- ((ManagedPtr FontDescription -> FontDescription)
-> Ptr FontDescription -> IO FontDescription
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontDescription -> FontDescription
Pango.FontDescription.FontDescription) Ptr FontDescription
result'
            FontDescription -> IO FontDescription
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Maybe FontDescription -> IO (Maybe FontDescription)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontDescription
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FontDialogChooseFontFinishMethodInfo
instance (signature ~ (b -> m (Maybe Pango.FontDescription.FontDescription)), MonadIO m, IsFontDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FontDialogChooseFontFinishMethodInfo a signature where
    overloadedMethod = fontDialogChooseFontFinish

instance O.OverloadedMethodInfo FontDialogChooseFontFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogChooseFontFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogChooseFontFinish"
        })


#endif

-- method FontDialog::get_filter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Filter" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_get_filter" gtk_font_dialog_get_filter :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    IO (Ptr Gtk.Filter.Filter)

-- | Returns the filter that decides which fonts to display
-- in the font chooser dialog.
-- 
-- /Since: 4.10/
fontDialogGetFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> m (Maybe Gtk.Filter.Filter)
    -- ^ __Returns:__ the filter
fontDialogGetFilter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontDialog a) =>
a -> m (Maybe Filter)
fontDialogGetFilter a
self = IO (Maybe Filter) -> m (Maybe Filter)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Filter) -> m (Maybe Filter))
-> IO (Maybe Filter) -> m (Maybe Filter)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Filter
result <- Ptr FontDialog -> IO (Ptr Filter)
gtk_font_dialog_get_filter Ptr FontDialog
self'
    Maybe Filter
maybeResult <- Ptr Filter -> (Ptr Filter -> IO Filter) -> IO (Maybe Filter)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Filter
result ((Ptr Filter -> IO Filter) -> IO (Maybe Filter))
-> (Ptr Filter -> IO Filter) -> IO (Maybe Filter)
forall a b. (a -> b) -> a -> b
$ \Ptr Filter
result' -> do
        Filter
result'' <- ((ManagedPtr Filter -> Filter) -> Ptr Filter -> IO Filter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Filter -> Filter
Gtk.Filter.Filter) Ptr Filter
result'
        Filter -> IO Filter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Filter
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Filter -> IO (Maybe Filter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Filter
maybeResult

#if defined(ENABLE_OVERLOADING)
data FontDialogGetFilterMethodInfo
instance (signature ~ (m (Maybe Gtk.Filter.Filter)), MonadIO m, IsFontDialog a) => O.OverloadedMethod FontDialogGetFilterMethodInfo a signature where
    overloadedMethod = fontDialogGetFilter

instance O.OverloadedMethodInfo FontDialogGetFilterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogGetFilter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogGetFilter"
        })


#endif

-- method FontDialog::get_font_map
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , 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 "gtk_font_dialog_get_font_map" gtk_font_dialog_get_font_map :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    IO (Ptr Pango.FontMap.FontMap)

-- | Returns the fontmap from which fonts are selected,
-- or @NULL@ for the default fontmap.
-- 
-- /Since: 4.10/
fontDialogGetFontMap ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> m (Maybe Pango.FontMap.FontMap)
    -- ^ __Returns:__ the fontmap
fontDialogGetFontMap :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontDialog a) =>
a -> m (Maybe FontMap)
fontDialogGetFontMap a
self = IO (Maybe FontMap) -> m (Maybe FontMap)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FontMap) -> m (Maybe FontMap))
-> IO (Maybe FontMap) -> m (Maybe FontMap)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr FontMap
result <- Ptr FontDialog -> IO (Ptr FontMap)
gtk_font_dialog_get_font_map Ptr FontDialog
self'
    Maybe FontMap
maybeResult <- Ptr FontMap -> (Ptr FontMap -> IO FontMap) -> IO (Maybe FontMap)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FontMap
result ((Ptr FontMap -> IO FontMap) -> IO (Maybe FontMap))
-> (Ptr FontMap -> IO FontMap) -> IO (Maybe FontMap)
forall a b. (a -> b) -> a -> b
$ \Ptr FontMap
result' -> do
        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'
        FontMap -> IO FontMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FontMap
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe FontMap -> IO (Maybe FontMap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontMap
maybeResult

#if defined(ENABLE_OVERLOADING)
data FontDialogGetFontMapMethodInfo
instance (signature ~ (m (Maybe Pango.FontMap.FontMap)), MonadIO m, IsFontDialog a) => O.OverloadedMethod FontDialogGetFontMapMethodInfo a signature where
    overloadedMethod = fontDialogGetFontMap

instance O.OverloadedMethodInfo FontDialogGetFontMapMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogGetFontMap",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogGetFontMap"
        })


#endif

-- method FontDialog::get_language
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , 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 "gtk_font_dialog_get_language" gtk_font_dialog_get_language :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    IO (Ptr Pango.Language.Language)

-- | Returns the language for which font features are applied.
-- 
-- /Since: 4.10/
fontDialogGetLanguage ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> m (Maybe Pango.Language.Language)
    -- ^ __Returns:__ the language for font features
fontDialogGetLanguage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontDialog a) =>
a -> m (Maybe Language)
fontDialogGetLanguage a
self = IO (Maybe Language) -> m (Maybe Language)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Language) -> m (Maybe Language))
-> IO (Maybe Language) -> m (Maybe Language)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Language
result <- Ptr FontDialog -> IO (Ptr Language)
gtk_font_dialog_get_language Ptr FontDialog
self'
    Maybe Language
maybeResult <- Ptr Language
-> (Ptr Language -> IO Language) -> IO (Maybe Language)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Language
result ((Ptr Language -> IO Language) -> IO (Maybe Language))
-> (Ptr Language -> IO Language) -> IO (Maybe Language)
forall a b. (a -> b) -> a -> b
$ \Ptr Language
result' -> do
        Language
result'' <- ((ManagedPtr Language -> Language) -> Ptr Language -> IO Language
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Language -> Language
Pango.Language.Language) Ptr Language
result'
        Language -> IO Language
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Language
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Language -> IO (Maybe Language)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Language
maybeResult

#if defined(ENABLE_OVERLOADING)
data FontDialogGetLanguageMethodInfo
instance (signature ~ (m (Maybe Pango.Language.Language)), MonadIO m, IsFontDialog a) => O.OverloadedMethod FontDialogGetLanguageMethodInfo a signature where
    overloadedMethod = fontDialogGetLanguage

instance O.OverloadedMethodInfo FontDialogGetLanguageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogGetLanguage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogGetLanguage"
        })


#endif

-- method FontDialog::get_modal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , 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_font_dialog_get_modal" gtk_font_dialog_get_modal :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    IO CInt

-- | Returns whether the font chooser dialog
-- blocks interaction with the parent window
-- while it is presented.
-- 
-- /Since: 4.10/
fontDialogGetModal ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the font chooser dialog is modal
fontDialogGetModal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontDialog a) =>
a -> m Bool
fontDialogGetModal a
self = IO Bool -> m Bool
forall a. IO a -> m a
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 FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr FontDialog -> IO CInt
gtk_font_dialog_get_modal Ptr FontDialog
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FontDialogGetModalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFontDialog a) => O.OverloadedMethod FontDialogGetModalMethodInfo a signature where
    overloadedMethod = fontDialogGetModal

instance O.OverloadedMethodInfo FontDialogGetModalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogGetModal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogGetModal"
        })


#endif

-- method FontDialog::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_get_title" gtk_font_dialog_get_title :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    IO CString

-- | Returns the title that will be shown on the
-- font chooser dialog.
-- 
-- /Since: 4.10/
fontDialogGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> m T.Text
    -- ^ __Returns:__ the title
fontDialogGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontDialog a) =>
a -> m Text
fontDialogGetTitle a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr FontDialog -> IO CString
gtk_font_dialog_get_title Ptr FontDialog
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontDialogGetTitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FontDialogGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFontDialog a) => O.OverloadedMethod FontDialogGetTitleMethodInfo a signature where
    overloadedMethod = fontDialogGetTitle

instance O.OverloadedMethodInfo FontDialogGetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogGetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogGetTitle"
        })


#endif

-- method FontDialog::set_filter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Filter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFilter`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_set_filter" gtk_font_dialog_set_filter :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Gtk.Filter.Filter ->                -- filter : TInterface (Name {namespace = "Gtk", name = "Filter"})
    IO ()

-- | Adds a filter that decides which fonts to display
-- in the font chooser dialog.
-- 
-- The @GtkFilter@ must be able to handle both @PangoFontFamily@
-- and @PangoFontFace@ objects.
-- 
-- /Since: 4.10/
fontDialogSetFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gtk.Filter.IsFilter b) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> Maybe (b)
    -- ^ /@filter@/: a @GtkFilter@
    -> m ()
fontDialogSetFilter :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFontDialog a, IsFilter b) =>
a -> Maybe b -> m ()
fontDialogSetFilter a
self Maybe b
filter = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Filter
maybeFilter <- case Maybe b
filter of
        Maybe b
Nothing -> Ptr Filter -> IO (Ptr Filter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Filter
forall a. Ptr a
nullPtr
        Just b
jFilter -> do
            Ptr Filter
jFilter' <- b -> IO (Ptr Filter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFilter
            Ptr Filter -> IO (Ptr Filter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Filter
jFilter'
    Ptr FontDialog -> Ptr Filter -> IO ()
gtk_font_dialog_set_filter Ptr FontDialog
self' Ptr Filter
maybeFilter
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
filter b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDialogSetFilterMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFontDialog a, Gtk.Filter.IsFilter b) => O.OverloadedMethod FontDialogSetFilterMethodInfo a signature where
    overloadedMethod = fontDialogSetFilter

instance O.OverloadedMethodInfo FontDialogSetFilterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogSetFilter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogSetFilter"
        })


#endif

-- method FontDialog::set_font_map
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fontmap"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontMap" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the fontmap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_set_font_map" gtk_font_dialog_set_font_map :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Pango.FontMap.FontMap ->            -- fontmap : TInterface (Name {namespace = "Pango", name = "FontMap"})
    IO ()

-- | Sets the fontmap from which fonts are selected.
-- 
-- If /@fontmap@/ is @NULL@, the default fontmap is used.
-- 
-- /Since: 4.10/
fontDialogSetFontMap ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Pango.FontMap.IsFontMap b) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> Maybe (b)
    -- ^ /@fontmap@/: the fontmap
    -> m ()
fontDialogSetFontMap :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFontDialog a, IsFontMap b) =>
a -> Maybe b -> m ()
fontDialogSetFontMap a
self Maybe b
fontmap = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr FontMap
maybeFontmap <- case Maybe b
fontmap of
        Maybe b
Nothing -> Ptr FontMap -> IO (Ptr FontMap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontMap
forall a. Ptr a
nullPtr
        Just b
jFontmap -> do
            Ptr FontMap
jFontmap' <- b -> IO (Ptr FontMap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFontmap
            Ptr FontMap -> IO (Ptr FontMap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontMap
jFontmap'
    Ptr FontDialog -> Ptr FontMap -> IO ()
gtk_font_dialog_set_font_map Ptr FontDialog
self' Ptr FontMap
maybeFontmap
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
fontmap b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDialogSetFontMapMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFontDialog a, Pango.FontMap.IsFontMap b) => O.OverloadedMethod FontDialogSetFontMapMethodInfo a signature where
    overloadedMethod = fontDialogSetFontMap

instance O.OverloadedMethodInfo FontDialogSetFontMapMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogSetFontMap",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogSetFontMap"
        })


#endif

-- method FontDialog::set_language
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , 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 language for font features"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_set_language" gtk_font_dialog_set_language :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Pango.Language.Language ->          -- language : TInterface (Name {namespace = "Pango", name = "Language"})
    IO ()

-- | Sets the language for which font features are applied.
-- 
-- /Since: 4.10/
fontDialogSetLanguage ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> Pango.Language.Language
    -- ^ /@language@/: the language for font features
    -> m ()
fontDialogSetLanguage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontDialog a) =>
a -> Language -> m ()
fontDialogSetLanguage a
self Language
language = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Language
language' <- Language -> IO (Ptr Language)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Language
language
    Ptr FontDialog -> Ptr Language -> IO ()
gtk_font_dialog_set_language Ptr FontDialog
self' Ptr Language
language'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Language -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Language
language
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDialogSetLanguageMethodInfo
instance (signature ~ (Pango.Language.Language -> m ()), MonadIO m, IsFontDialog a) => O.OverloadedMethod FontDialogSetLanguageMethodInfo a signature where
    overloadedMethod = fontDialogSetLanguage

instance O.OverloadedMethodInfo FontDialogSetLanguageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogSetLanguage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogSetLanguage"
        })


#endif

-- method FontDialog::set_modal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modal"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_set_modal" gtk_font_dialog_set_modal :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    CInt ->                                 -- modal : TBasicType TBoolean
    IO ()

-- | Sets whether the font chooser dialog
-- blocks interaction with the parent window
-- while it is presented.
-- 
-- /Since: 4.10/
fontDialogSetModal ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> Bool
    -- ^ /@modal@/: the new value
    -> m ()
fontDialogSetModal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontDialog a) =>
a -> Bool -> m ()
fontDialogSetModal a
self Bool
modal = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let modal' :: CInt
modal' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
modal
    Ptr FontDialog -> CInt -> IO ()
gtk_font_dialog_set_modal Ptr FontDialog
self' CInt
modal'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontDialogSetModalMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFontDialog a) => O.OverloadedMethod FontDialogSetModalMethodInfo a signature where
    overloadedMethod = fontDialogSetModal

instance O.OverloadedMethodInfo FontDialogSetModalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogSetModal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogSetModal"
        })


#endif

-- method FontDialog::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFontDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new title" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_font_dialog_set_title" gtk_font_dialog_set_title :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

-- | Sets the title that will be shown on the
-- font chooser dialog.
-- 
-- /Since: 4.10/
fontDialogSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a) =>
    a
    -- ^ /@self@/: a @GtkFontDialog@
    -> T.Text
    -- ^ /@title@/: the new title
    -> m ()
fontDialogSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontDialog a) =>
a -> Text -> m ()
fontDialogSetTitle a
self Text
title = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontDialog
self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr FontDialog -> CString -> IO ()
gtk_font_dialog_set_title Ptr FontDialog
self' CString
title'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo FontDialogSetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FontDialog.fontDialogSetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogSetTitle"
        })


#endif