{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Asynchronous API to present a font chooser dialog.
-- 
-- @GtkFontDialog@ collects the arguments that are needed to present
-- the 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.
-- 
-- 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
    ( 

-- * 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         ,


-- ** chooseFontAndFeaturesFinish #method:chooseFontAndFeaturesFinish#

#if defined(ENABLE_OVERLOADING)
    FontDialogChooseFontAndFeaturesFinishMethodInfo,
#endif
    fontDialogChooseFontAndFeaturesFinish   ,


-- ** 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#
-- | 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#
-- | 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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.Clipboard as Gdk.Clipboard
import qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
import qualified GI.Gdk.Objects.Device as Gdk.Device
import qualified GI.Gdk.Objects.Display as Gdk.Display
import qualified GI.Gdk.Objects.Event as Gdk.Event
import qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import qualified GI.Gdk.Objects.Monitor as Gdk.Monitor
import qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import qualified GI.Gdk.Objects.Surface as Gdk.Surface
import qualified GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup
import qualified GI.Gio.Interfaces.ActionMap as Gio.ActionMap
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Objects.Application as Gio.Application
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.Menu as Gio.Menu
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import qualified GI.Graphene.Structs.Matrix as Graphene.Matrix
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Point3D as Graphene.Point3D
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Graphene.Structs.Size as Graphene.Size
import qualified GI.Graphene.Structs.Vec3 as Graphene.Vec3
import qualified GI.Graphene.Structs.Vec4 as Graphene.Vec4
import qualified GI.Gsk.Enums as Gsk.Enums
import qualified GI.Gsk.Objects.GLShader as Gsk.GLShader
import qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import qualified GI.Gsk.Objects.Renderer as Gsk.Renderer
import qualified GI.Gsk.Structs.ColorStop as Gsk.ColorStop
import qualified GI.Gsk.Structs.Path as Gsk.Path
import qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect
import qualified GI.Gsk.Structs.Shadow as Gsk.Shadow
import qualified GI.Gsk.Structs.Stroke as Gsk.Stroke
import qualified GI.Gsk.Structs.Transform as Gsk.Transform
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Native as Gtk.Native
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Root as Gtk.Root
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ShortcutManager as Gtk.ShortcutManager
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.StyleProvider as Gtk.StyleProvider
import {-# SOURCE #-} qualified GI.Gtk.Objects.ATContext as Gtk.ATContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.Application as Gtk.Application
import {-# SOURCE #-} qualified GI.Gtk.Objects.EventController as Gtk.EventController
import {-# SOURCE #-} qualified GI.Gtk.Objects.Filter as Gtk.Filter
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutChild as Gtk.LayoutChild
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutManager as Gtk.LayoutManager
import {-# SOURCE #-} qualified GI.Gtk.Objects.Settings as Gtk.Settings
import {-# SOURCE #-} qualified GI.Gtk.Objects.Snapshot as Gtk.Snapshot
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.Tooltip as Gtk.Tooltip
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.Gtk.Objects.Window as Gtk.Window
import {-# SOURCE #-} qualified GI.Gtk.Objects.WindowGroup as Gtk.WindowGroup
import {-# SOURCE #-} qualified GI.Gtk.Structs.Border as Gtk.Border
import {-# SOURCE #-} qualified GI.Gtk.Structs.Requisition as Gtk.Requisition
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Objects.Context as Pango.Context
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.Objects.Layout as Pango.Layout
import qualified GI.Pango.Structs.FontDescription as Pango.FontDescription
import qualified GI.Pango.Structs.Language as Pango.Language

#else
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

#endif

-- | 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 t'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 t'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 t'FontDialog' to and from t'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 <- 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 /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newObject FontDialog ptr
        else return 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 t'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-gtk4-4.0.12/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 t'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-gtk4-4.0.12/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 t'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-gtk4-4.0.12/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 t'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-gtk4-4.0.12/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 t'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-gtk4-4.0.12/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
    result <- IO (Ptr FontDialog)
gtk_font_dialog_new
    checkUnexpectedReturnNULL "fontDialogNew" result
    result' <- (wrapObject FontDialog) result
    return 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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cancellable to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 ()

-- | Presents a font chooser dialog to the user.
-- 
-- The font chooser dialog will be set up for selecting a font face.
-- 
-- A font face represents a font family and style, but no specific font size.
-- 
-- /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 font dialog
    -> Maybe (b)
    -- ^ /@parent@/: the parent window
    -> Maybe (c)
    -- ^ /@initialValue@/: the initial value
    -> Maybe (d)
    -- ^ /@cancellable@/: a cancellable 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case 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
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeInitialValue <- case 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
FP.nullPtr
        Just c
jInitialValue -> do
            jInitialValue' <- c -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jInitialValue
            return jInitialValue'
    maybeCancellable <- case 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
FP.nullPtr
        Just d
jCancellable -> do
            jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            return jCancellable'
    maybeCallback <- case 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 FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_font_dialog_choose_face self' maybeParent maybeInitialValue maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust initialValue touchManagedPtr
    whenJust cancellable touchManagedPtr
    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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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.
-- 
-- /Since: 4.10/
fontDialogChooseFaceFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a font dialog
    -> b
    -- ^ /@result@/: the result
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gtk_font_dialog_choose_face_finish self' result_'
        maybeResult <- convertIfNonNull result $ \Ptr FontFace
result' -> do
            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'
            return result''
        touchManagedPtr self
        touchManagedPtr result_
        return maybeResult
     ) (do
        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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cancellable to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 ()

-- | Presents a font chooser dialog to the user.
-- 
-- The font chooser dialog will be set up for selecting a font family.
-- 
-- /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 font dialog
    -> Maybe (b)
    -- ^ /@parent@/: the parent window
    -> Maybe (c)
    -- ^ /@initialValue@/: the initial value
    -> Maybe (d)
    -- ^ /@cancellable@/: a cancellable 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case 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
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeInitialValue <- case 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
FP.nullPtr
        Just c
jInitialValue -> do
            jInitialValue' <- c -> IO (Ptr FontFamily)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jInitialValue
            return jInitialValue'
    maybeCancellable <- case 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
FP.nullPtr
        Just d
jCancellable -> do
            jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            return jCancellable'
    maybeCallback <- case 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 FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_font_dialog_choose_family self' maybeParent maybeInitialValue maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust initialValue touchManagedPtr
    whenJust cancellable touchManagedPtr
    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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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.
-- 
-- 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 font dialog
    -> b
    -- ^ /@result@/: the result
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gtk_font_dialog_choose_family_finish self' result_'
        maybeResult <- convertIfNonNull result $ \Ptr FontFamily
result' -> do
            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'
            return result''
        touchManagedPtr self
        touchManagedPtr result_
        return maybeResult
     ) (do
        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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cancellable to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 ()

-- | Presents a font chooser dialog to the user.
-- 
-- The font chooser dialog will be set up for selecting a font.
-- 
-- 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 font dialog
    -> Maybe (b)
    -- ^ /@parent@/: the parent window
    -> Maybe (Pango.FontDescription.FontDescription)
    -- ^ /@initialValue@/: the font to select initially
    -> Maybe (c)
    -- ^ /@cancellable@/: a cancellable 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case 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
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeInitialValue <- case 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
FP.nullPtr
        Just FontDescription
jInitialValue -> do
            jInitialValue' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
jInitialValue
            return jInitialValue'
    maybeCancellable <- case 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
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case 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 FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_font_dialog_choose_font self' maybeParent maybeInitialValue maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust initialValue touchManagedPtr
    whenJust cancellable touchManagedPtr
    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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cancellable to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 ()

-- | Presents a font chooser dialog to the user.
-- 
-- The font chooser dialog will be set up for selecting a font
-- and specify features for the selected font.
-- 
-- Font features affect how the font is rendered, for example
-- enabling glyph variants or ligatures.
-- 
-- /Since: 4.10/
fontDialogChooseFontAndFeatures ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a font dialog
    -> Maybe (b)
    -- ^ /@parent@/: the parent window
    -> Maybe (Pango.FontDescription.FontDescription)
    -- ^ /@initialValue@/: the font to select initially
    -> Maybe (c)
    -- ^ /@cancellable@/: a cancellable 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case 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
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeInitialValue <- case 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
FP.nullPtr
        Just FontDescription
jInitialValue -> do
            jInitialValue' <- FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontDescription
jInitialValue
            return jInitialValue'
    maybeCancellable <- case 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
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case 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 FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_font_dialog_choose_font_and_features self' maybeParent maybeInitialValue maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust initialValue touchManagedPtr
    whenJust cancellable touchManagedPtr
    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-gtk4-4.0.12/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogChooseFontAndFeatures"
        })


#endif

-- method FontDialog::choose_font_and_features_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FontDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "font_desc"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontDescription" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for font description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "font_features"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for font features"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "language"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Language" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the language"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gtk_font_dialog_choose_font_and_features_finish" gtk_font_dialog_choose_font_and_features_finish :: 
    Ptr FontDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FontDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr Pango.FontDescription.FontDescription) -> -- font_desc : TInterface (Name {namespace = "Pango", name = "FontDescription"})
    Ptr CString ->                          -- font_features : TBasicType TUTF8
    Ptr (Ptr Pango.Language.Language) ->    -- language : TInterface (Name {namespace = "Pango", name = "Language"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes the 'GI.Gtk.Objects.FontDialog.fontDialogChooseFontAndFeatures' call.
-- 
-- The selected font and features are returned in /@fontDesc@/ and
-- /@fontFeatures@/.
-- 
-- /Since: 4.10/
fontDialogChooseFontAndFeaturesFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a font dialog
    -> b
    -- ^ /@result@/: the result
    -> m ((Pango.FontDescription.FontDescription, T.Text, Pango.Language.Language))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fontDialogChooseFontAndFeaturesFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFontDialog a, IsAsyncResult b) =>
a -> b -> m (FontDescription, Text, Language)
fontDialogChooseFontAndFeaturesFinish a
self b
result_ = IO (FontDescription, Text, Language)
-> m (FontDescription, Text, Language)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FontDescription, Text, Language)
 -> m (FontDescription, Text, Language))
-> IO (FontDescription, Text, Language)
-> m (FontDescription, Text, Language)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    fontDesc <- callocMem :: IO (Ptr (Ptr Pango.FontDescription.FontDescription))
    fontFeatures <- callocMem :: IO (Ptr CString)
    language <- callocMem :: IO (Ptr (Ptr Pango.Language.Language))
    onException (do
        _ <- propagateGError $ gtk_font_dialog_choose_font_and_features_finish self' result_' fontDesc fontFeatures language
        fontDesc' <- peek fontDesc
        fontDesc'' <- (wrapBoxed Pango.FontDescription.FontDescription) fontDesc'
        fontFeatures' <- peek fontFeatures
        fontFeatures'' <- cstringToText fontFeatures'
        freeMem fontFeatures'
        language' <- peek language
        language'' <- (wrapBoxed Pango.Language.Language) language'
        touchManagedPtr self
        touchManagedPtr result_
        freeMem fontDesc
        freeMem fontFeatures
        freeMem language
        return (fontDesc'', fontFeatures'', language'')
     ) (do
        freeMem fontDesc
        freeMem fontFeatures
        freeMem language
     )

#if defined(ENABLE_OVERLOADING)
data FontDialogChooseFontAndFeaturesFinishMethodInfo
instance (signature ~ (b -> m ((Pango.FontDescription.FontDescription, T.Text, Pango.Language.Language))), MonadIO m, IsFontDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FontDialogChooseFontAndFeaturesFinishMethodInfo a signature where
    overloadedMethod = fontDialogChooseFontAndFeaturesFinish

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


#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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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.
-- 
-- /Since: 4.10/
fontDialogChooseFontFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a font dialog
    -> b
    -- ^ /@result@/: the result
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gtk_font_dialog_choose_font_finish self' result_'
        maybeResult <- convertIfNonNull result $ \Ptr FontDescription
result' -> do
            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'
            return result''
        touchManagedPtr self
        touchManagedPtr result_
        return maybeResult
     ) (do
        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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 font dialog
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_font_dialog_get_filter self'
    maybeResult <- convertIfNonNull result $ \Ptr Filter
result' -> do
        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'
        return result''
    touchManagedPtr self
    return 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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 font dialog
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_font_dialog_get_font_map self'
    maybeResult <- convertIfNonNull result $ \Ptr FontMap
result' -> do
        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'
        return result''
    touchManagedPtr self
    return 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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 font dialog
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_font_dialog_get_language self'
    maybeResult <- convertIfNonNull result $ \Ptr Language
result' -> do
        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'
        return result''
    touchManagedPtr self
    return 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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 font dialog
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_font_dialog_get_modal self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return 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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 font dialog
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_font_dialog_get_title self'
    checkUnexpectedReturnNULL "fontDialogGetTitle" result
    result' <- cstringToText result
    touchManagedPtr self
    return 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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Filter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the filter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 filter 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 font dialog
    -> Maybe (b)
    -- ^ /@filter@/: the filter
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeFilter <- case 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
FP.nullPtr
        Just b
jFilter -> do
            jFilter' <- b -> IO (Ptr Filter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFilter
            return jFilter'
    gtk_font_dialog_set_filter self' maybeFilter
    touchManagedPtr self
    whenJust filter touchManagedPtr
    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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 font dialog
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeFontmap <- case 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
FP.nullPtr
        Just b
jFontmap -> do
            jFontmap' <- b -> IO (Ptr FontMap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFontmap
            return jFontmap'
    gtk_font_dialog_set_font_map self' maybeFontmap
    touchManagedPtr self
    whenJust fontmap touchManagedPtr
    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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 font dialog
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    language' <- unsafeManagedPtrGetPtr language
    gtk_font_dialog_set_language self' language'
    touchManagedPtr self
    touchManagedPtr language
    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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 font dialog
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let 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
    gtk_font_dialog_set_modal self' modal'
    touchManagedPtr self
    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-gtk4-4.0.12/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 font dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 font dialog
    -> 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
    self' <- a -> IO (Ptr FontDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    title' <- textToCString title
    gtk_font_dialog_set_title self' title'
    touchManagedPtr self
    freeMem title'
    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-gtk4-4.0.12/docs/GI-Gtk-Objects-FontDialog.html#v:fontDialogSetTitle"
        })


#endif