{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Dialog boxes are a convenient way to prompt the user for a small amount
-- of input, e.g. to display a message, ask a question, or anything else
-- that does not require extensive effort on the user’s part.
-- 
-- GTK+ treats a dialog as a window split vertically. The top section is a
-- t'GI.Gtk.Objects.Box.Box', and is where widgets such as a t'GI.Gtk.Objects.Label.Label' or a t'GI.Gtk.Objects.Entry.Entry' should
-- be packed. The bottom area is known as the
-- “action area”. This is generally used for
-- packing buttons into the dialog which may perform functions such as
-- cancel, ok, or apply.
-- 
-- t'GI.Gtk.Objects.Dialog.Dialog' boxes are created with a call to 'GI.Gtk.Objects.Dialog.dialogNew' or
-- @/gtk_dialog_new_with_buttons()/@. @/gtk_dialog_new_with_buttons()/@ is
-- recommended; it allows you to set the dialog title, some convenient
-- flags, and add simple buttons.
-- 
-- A “modal” dialog (that is, one which freezes the rest of the application
-- from user input), can be created by calling 'GI.Gtk.Objects.Window.windowSetModal' on the
-- dialog. Use the @/GTK_WINDOW()/@ macro to cast the widget returned from
-- 'GI.Gtk.Objects.Dialog.dialogNew' into a t'GI.Gtk.Objects.Window.Window'. When using @/gtk_dialog_new_with_buttons()/@
-- you can also pass the @/GTK_DIALOG_MODAL/@ flag to make a dialog modal.
-- 
-- If you add buttons to t'GI.Gtk.Objects.Dialog.Dialog' using @/gtk_dialog_new_with_buttons()/@,
-- 'GI.Gtk.Objects.Dialog.dialogAddButton', @/gtk_dialog_add_buttons()/@, or
-- 'GI.Gtk.Objects.Dialog.dialogAddActionWidget', clicking the button will emit a signal
-- called [response]("GI.Gtk.Objects.Dialog#g:signal:response") with a response ID that you specified. GTK+
-- will never assign a meaning to positive response IDs; these are entirely
-- user-defined. But for convenience, you can use the response IDs in the
-- t'GI.Gtk.Enums.ResponseType' enumeration (these all have values less than zero). If
-- a dialog receives a delete event, the [response]("GI.Gtk.Objects.Dialog#g:signal:response") signal will
-- be emitted with a response ID of @/GTK_RESPONSE_DELETE_EVENT/@.
-- 
-- For the simple dialog in the following example, in reality you’d probably
-- use t'GI.Gtk.Objects.MessageDialog.MessageDialog' to save yourself some effort. But you’d need to
-- create the dialog contents manually if you had more than a simple message
-- in the dialog.
-- 
-- An example for simple GtkDialog usage:
-- 
-- === /C code/
-- >
-- >// Function to open a dialog box with a message
-- >void
-- >quick_message (GtkWindow *parent, gchar *message)
-- >{
-- > GtkWidget *dialog, *label, *content_area;
-- > GtkDialogFlags flags;
-- >
-- > // Create the widgets
-- > flags = GTK_DIALOG_DESTROY_WITH_PARENT;
-- > dialog = gtk_dialog_new_with_buttons ("Message",
-- >                                       parent,
-- >                                       flags,
-- >                                       _("_OK"),
-- >                                       GTK_RESPONSE_NONE,
-- >                                       NULL);
-- > content_area = gtk_dialog_get_content_area (GTK_DIALOG (dialog));
-- > label = gtk_label_new (message);
-- >
-- > // Ensure that the dialog box is destroyed when the user responds
-- >
-- > g_signal_connect_swapped (dialog,
-- >                           "response",
-- >                           G_CALLBACK (gtk_window_destroy),
-- >                           dialog);
-- >
-- > // Add the label, and show everything we’ve added
-- >
-- > gtk_box_append (GTK_BOX (content_area), label);
-- > gtk_widget_show (dialog);
-- >}
-- 
-- 
-- = GtkDialog as GtkBuildable
-- 
-- The GtkDialog implementation of the t'GI.Gtk.Interfaces.Buildable.Buildable' interface exposes the
-- /@contentArea@/ and /@actionArea@/ as internal children with the names
-- “content_area” and “action_area”.
-- 
-- GtkDialog supports a custom \<action-widgets> element, which can contain
-- multiple \<action-widget> elements. The “response” attribute specifies a
-- numeric response, and the content of the element is the id of widget
-- (which should be a child of the dialogs /@actionArea@/). To mark a response
-- as default, set the “default“ attribute of the \<action-widget> element
-- to true.
-- 
-- GtkDialog supports adding action widgets by specifying “action“ as
-- the “type“ attribute of a \<child> element. The widget will be added
-- either to the action area or the headerbar of the dialog, depending
-- on the “use-header-bar“ property. The response id has to be associated
-- with the action widget using the \<action-widgets> element.
-- 
-- An example of a t'GI.Gtk.Objects.Dialog.Dialog' UI definition fragment:
-- >
-- ><object class="GtkDialog" id="dialog1">
-- >  <child type="action">
-- >    <object class="GtkButton" id="button_cancel"/>
-- >  </child>
-- >  <child type="action">
-- >    <object class="GtkButton" id="button_ok">
-- >    </object>
-- >  </child>
-- >  <action-widgets>
-- >    <action-widget response="cancel">button_cancel</action-widget>
-- >    <action-widget response="ok" default="true">button_ok</action-widget>
-- >  </action-widgets>
-- ></object>
-- 

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

module GI.Gtk.Objects.Dialog
    ( 

-- * Exported types
    Dialog(..)                              ,
    IsDialog                                ,
    toDialog                                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDialogMethod                     ,
#endif


-- ** addActionWidget #method:addActionWidget#

#if defined(ENABLE_OVERLOADING)
    DialogAddActionWidgetMethodInfo         ,
#endif
    dialogAddActionWidget                   ,


-- ** addButton #method:addButton#

#if defined(ENABLE_OVERLOADING)
    DialogAddButtonMethodInfo               ,
#endif
    dialogAddButton                         ,


-- ** getContentArea #method:getContentArea#

#if defined(ENABLE_OVERLOADING)
    DialogGetContentAreaMethodInfo          ,
#endif
    dialogGetContentArea                    ,


-- ** getHeaderBar #method:getHeaderBar#

#if defined(ENABLE_OVERLOADING)
    DialogGetHeaderBarMethodInfo            ,
#endif
    dialogGetHeaderBar                      ,


-- ** getResponseForWidget #method:getResponseForWidget#

#if defined(ENABLE_OVERLOADING)
    DialogGetResponseForWidgetMethodInfo    ,
#endif
    dialogGetResponseForWidget              ,


-- ** getWidgetForResponse #method:getWidgetForResponse#

#if defined(ENABLE_OVERLOADING)
    DialogGetWidgetForResponseMethodInfo    ,
#endif
    dialogGetWidgetForResponse              ,


-- ** new #method:new#

    dialogNew                               ,


-- ** response #method:response#

#if defined(ENABLE_OVERLOADING)
    DialogResponseMethodInfo                ,
#endif
    dialogResponse                          ,


-- ** setDefaultResponse #method:setDefaultResponse#

#if defined(ENABLE_OVERLOADING)
    DialogSetDefaultResponseMethodInfo      ,
#endif
    dialogSetDefaultResponse                ,


-- ** setResponseSensitive #method:setResponseSensitive#

#if defined(ENABLE_OVERLOADING)
    DialogSetResponseSensitiveMethodInfo    ,
#endif
    dialogSetResponseSensitive              ,




 -- * Properties
-- ** useHeaderBar #attr:useHeaderBar#
-- | 'P.True' if the dialog uses a t'GI.Gtk.Objects.HeaderBar.HeaderBar' for action buttons
-- instead of the action-area.
-- 
-- For technical reasons, this property is declared as an integer
-- property, but you should only set it to 'P.True' or 'P.False'.

#if defined(ENABLE_OVERLOADING)
    DialogUseHeaderBarPropertyInfo          ,
#endif
    constructDialogUseHeaderBar             ,
#if defined(ENABLE_OVERLOADING)
    dialogUseHeaderBar                      ,
#endif
    getDialogUseHeaderBar                   ,




 -- * Signals
-- ** close #signal:close#

    C_DialogCloseCallback                   ,
    DialogCloseCallback                     ,
#if defined(ENABLE_OVERLOADING)
    DialogCloseSignalInfo                   ,
#endif
    afterDialogClose                        ,
    genClosure_DialogClose                  ,
    mk_DialogCloseCallback                  ,
    noDialogCloseCallback                   ,
    onDialogClose                           ,
    wrap_DialogCloseCallback                ,


-- ** response #signal:response#

    C_DialogResponseCallback                ,
    DialogResponseCallback                  ,
#if defined(ENABLE_OVERLOADING)
    DialogResponseSignalInfo                ,
#endif
    afterDialogResponse                     ,
    genClosure_DialogResponse               ,
    mk_DialogResponseCallback               ,
    noDialogResponseCallback                ,
    onDialogResponse                        ,
    wrap_DialogResponseCallback             ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
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.Objects.Box as Gtk.Box
import {-# SOURCE #-} qualified GI.Gtk.Objects.HeaderBar as Gtk.HeaderBar
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.Gtk.Objects.Window as Gtk.Window

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

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

foreign import ccall "gtk_dialog_get_type"
    c_gtk_dialog_get_type :: IO B.Types.GType

instance B.Types.TypedObject Dialog where
    glibType :: IO GType
glibType = IO GType
c_gtk_dialog_get_type

instance B.Types.GObject Dialog

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

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

instance O.HasParentTypes Dialog
type instance O.ParentTypes Dialog = '[Gtk.Window.Window, Gtk.Widget.Widget, GObject.Object.Object, Atk.ImplementorIface.ImplementorIface, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget, Gtk.Native.Native, Gtk.Root.Root, Gtk.ShortcutManager.ShortcutManager]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDialogMethod (t :: Symbol) (o :: *) :: * where
    ResolveDialogMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveDialogMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveDialogMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveDialogMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveDialogMethod "addActionWidget" o = DialogAddActionWidgetMethodInfo
    ResolveDialogMethod "addButton" o = DialogAddButtonMethodInfo
    ResolveDialogMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveDialogMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveDialogMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveDialogMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveDialogMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveDialogMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveDialogMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDialogMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDialogMethod "checkResize" o = Gtk.Native.NativeCheckResizeMethodInfo
    ResolveDialogMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveDialogMethod "close" o = Gtk.Window.WindowCloseMethodInfo
    ResolveDialogMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveDialogMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveDialogMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveDialogMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveDialogMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveDialogMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveDialogMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveDialogMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveDialogMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveDialogMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveDialogMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveDialogMethod "destroy" o = Gtk.Window.WindowDestroyMethodInfo
    ResolveDialogMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveDialogMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveDialogMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveDialogMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDialogMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDialogMethod "fullscreen" o = Gtk.Window.WindowFullscreenMethodInfo
    ResolveDialogMethod "fullscreenOnMonitor" o = Gtk.Window.WindowFullscreenOnMonitorMethodInfo
    ResolveDialogMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDialogMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveDialogMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveDialogMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveDialogMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveDialogMethod "hasGroup" o = Gtk.Window.WindowHasGroupMethodInfo
    ResolveDialogMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveDialogMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveDialogMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveDialogMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveDialogMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveDialogMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveDialogMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveDialogMethod "isActive" o = Gtk.Window.WindowIsActiveMethodInfo
    ResolveDialogMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveDialogMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveDialogMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDialogMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveDialogMethod "isMaximized" o = Gtk.Window.WindowIsMaximizedMethodInfo
    ResolveDialogMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveDialogMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveDialogMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveDialogMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveDialogMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveDialogMethod "maximize" o = Gtk.Window.WindowMaximizeMethodInfo
    ResolveDialogMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveDialogMethod "minimize" o = Gtk.Window.WindowMinimizeMethodInfo
    ResolveDialogMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveDialogMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDialogMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDialogMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveDialogMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveDialogMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveDialogMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveDialogMethod "present" o = Gtk.Window.WindowPresentMethodInfo
    ResolveDialogMethod "presentWithTime" o = Gtk.Window.WindowPresentWithTimeMethodInfo
    ResolveDialogMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveDialogMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveDialogMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveDialogMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveDialogMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDialogMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDialogMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveDialogMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveDialogMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveDialogMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveDialogMethod "resize" o = Gtk.Window.WindowResizeMethodInfo
    ResolveDialogMethod "response" o = DialogResponseMethodInfo
    ResolveDialogMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDialogMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolveDialogMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveDialogMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveDialogMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveDialogMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDialogMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDialogMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDialogMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveDialogMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveDialogMethod "unfullscreen" o = Gtk.Window.WindowUnfullscreenMethodInfo
    ResolveDialogMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveDialogMethod "unmaximize" o = Gtk.Window.WindowUnmaximizeMethodInfo
    ResolveDialogMethod "unminimize" o = Gtk.Window.WindowUnminimizeMethodInfo
    ResolveDialogMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveDialogMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveDialogMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDialogMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveDialogMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDialogMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveDialogMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveDialogMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveDialogMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveDialogMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveDialogMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveDialogMethod "getApplication" o = Gtk.Window.WindowGetApplicationMethodInfo
    ResolveDialogMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveDialogMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveDialogMethod "getChild" o = Gtk.Window.WindowGetChildMethodInfo
    ResolveDialogMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveDialogMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveDialogMethod "getContentArea" o = DialogGetContentAreaMethodInfo
    ResolveDialogMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveDialogMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveDialogMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveDialogMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDialogMethod "getDecorated" o = Gtk.Window.WindowGetDecoratedMethodInfo
    ResolveDialogMethod "getDefaultSize" o = Gtk.Window.WindowGetDefaultSizeMethodInfo
    ResolveDialogMethod "getDefaultWidget" o = Gtk.Window.WindowGetDefaultWidgetMethodInfo
    ResolveDialogMethod "getDeletable" o = Gtk.Window.WindowGetDeletableMethodInfo
    ResolveDialogMethod "getDestroyWithParent" o = Gtk.Window.WindowGetDestroyWithParentMethodInfo
    ResolveDialogMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveDialogMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveDialogMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveDialogMethod "getFocus" o = Gtk.Window.WindowGetFocusMethodInfo
    ResolveDialogMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveDialogMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveDialogMethod "getFocusVisible" o = Gtk.Window.WindowGetFocusVisibleMethodInfo
    ResolveDialogMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolveDialogMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveDialogMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveDialogMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveDialogMethod "getGroup" o = Gtk.Window.WindowGetGroupMethodInfo
    ResolveDialogMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveDialogMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveDialogMethod "getHeaderBar" o = DialogGetHeaderBarMethodInfo
    ResolveDialogMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveDialogMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveDialogMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveDialogMethod "getHideOnClose" o = Gtk.Window.WindowGetHideOnCloseMethodInfo
    ResolveDialogMethod "getIconName" o = Gtk.Window.WindowGetIconNameMethodInfo
    ResolveDialogMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveDialogMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveDialogMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveDialogMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveDialogMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveDialogMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveDialogMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveDialogMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveDialogMethod "getMnemonicsVisible" o = Gtk.Window.WindowGetMnemonicsVisibleMethodInfo
    ResolveDialogMethod "getModal" o = Gtk.Window.WindowGetModalMethodInfo
    ResolveDialogMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveDialogMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveDialogMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveDialogMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveDialogMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveDialogMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveDialogMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveDialogMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveDialogMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveDialogMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveDialogMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDialogMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDialogMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveDialogMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveDialogMethod "getRenderer" o = Gtk.Native.NativeGetRendererMethodInfo
    ResolveDialogMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveDialogMethod "getResizable" o = Gtk.Window.WindowGetResizableMethodInfo
    ResolveDialogMethod "getResponseForWidget" o = DialogGetResponseForWidgetMethodInfo
    ResolveDialogMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveDialogMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveDialogMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveDialogMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveDialogMethod "getSize" o = Gtk.Window.WindowGetSizeMethodInfo
    ResolveDialogMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveDialogMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveDialogMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveDialogMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveDialogMethod "getSurface" o = Gtk.Native.NativeGetSurfaceMethodInfo
    ResolveDialogMethod "getSurfaceTransform" o = Gtk.Native.NativeGetSurfaceTransformMethodInfo
    ResolveDialogMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveDialogMethod "getTitle" o = Gtk.Window.WindowGetTitleMethodInfo
    ResolveDialogMethod "getTitlebar" o = Gtk.Window.WindowGetTitlebarMethodInfo
    ResolveDialogMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveDialogMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveDialogMethod "getTransientFor" o = Gtk.Window.WindowGetTransientForMethodInfo
    ResolveDialogMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveDialogMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveDialogMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveDialogMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveDialogMethod "getWidgetForResponse" o = DialogGetWidgetForResponseMethodInfo
    ResolveDialogMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveDialogMethod "setApplication" o = Gtk.Window.WindowSetApplicationMethodInfo
    ResolveDialogMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveDialogMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveDialogMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveDialogMethod "setChild" o = Gtk.Window.WindowSetChildMethodInfo
    ResolveDialogMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveDialogMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolveDialogMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveDialogMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveDialogMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDialogMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDialogMethod "setDecorated" o = Gtk.Window.WindowSetDecoratedMethodInfo
    ResolveDialogMethod "setDefaultResponse" o = DialogSetDefaultResponseMethodInfo
    ResolveDialogMethod "setDefaultSize" o = Gtk.Window.WindowSetDefaultSizeMethodInfo
    ResolveDialogMethod "setDefaultWidget" o = Gtk.Window.WindowSetDefaultWidgetMethodInfo
    ResolveDialogMethod "setDeletable" o = Gtk.Window.WindowSetDeletableMethodInfo
    ResolveDialogMethod "setDestroyWithParent" o = Gtk.Window.WindowSetDestroyWithParentMethodInfo
    ResolveDialogMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveDialogMethod "setDisplay" o = Gtk.Window.WindowSetDisplayMethodInfo
    ResolveDialogMethod "setFocus" o = Gtk.Window.WindowSetFocusMethodInfo
    ResolveDialogMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveDialogMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveDialogMethod "setFocusVisible" o = Gtk.Window.WindowSetFocusVisibleMethodInfo
    ResolveDialogMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveDialogMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveDialogMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveDialogMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveDialogMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveDialogMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveDialogMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveDialogMethod "setHideOnClose" o = Gtk.Window.WindowSetHideOnCloseMethodInfo
    ResolveDialogMethod "setIconName" o = Gtk.Window.WindowSetIconNameMethodInfo
    ResolveDialogMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveDialogMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveDialogMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveDialogMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveDialogMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveDialogMethod "setMnemonicsVisible" o = Gtk.Window.WindowSetMnemonicsVisibleMethodInfo
    ResolveDialogMethod "setModal" o = Gtk.Window.WindowSetModalMethodInfo
    ResolveDialogMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveDialogMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveDialogMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveDialogMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveDialogMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDialogMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveDialogMethod "setResizable" o = Gtk.Window.WindowSetResizableMethodInfo
    ResolveDialogMethod "setResponseSensitive" o = DialogSetResponseSensitiveMethodInfo
    ResolveDialogMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveDialogMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveDialogMethod "setStartupId" o = Gtk.Window.WindowSetStartupIdMethodInfo
    ResolveDialogMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveDialogMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveDialogMethod "setTitle" o = Gtk.Window.WindowSetTitleMethodInfo
    ResolveDialogMethod "setTitlebar" o = Gtk.Window.WindowSetTitlebarMethodInfo
    ResolveDialogMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveDialogMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveDialogMethod "setTransientFor" o = Gtk.Window.WindowSetTransientForMethodInfo
    ResolveDialogMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveDialogMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveDialogMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveDialogMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveDialogMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Dialog::close
-- | The [close](#g:signal:close) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted when the user uses a keybinding to close
-- the dialog.
-- 
-- The default binding for this signal is the Escape key.
type DialogCloseCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `DialogCloseCallback`@.
noDialogCloseCallback :: Maybe DialogCloseCallback
noDialogCloseCallback :: Maybe (IO ())
noDialogCloseCallback = Maybe (IO ())
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_DialogClose :: MonadIO m => DialogCloseCallback -> m (GClosure C_DialogCloseCallback)
genClosure_DialogClose :: IO () -> m (GClosure C_DialogCloseCallback)
genClosure_DialogClose IO ()
cb = IO (GClosure C_DialogCloseCallback)
-> m (GClosure C_DialogCloseCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DialogCloseCallback)
 -> m (GClosure C_DialogCloseCallback))
-> IO (GClosure C_DialogCloseCallback)
-> m (GClosure C_DialogCloseCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DialogCloseCallback
cb' = IO () -> C_DialogCloseCallback
wrap_DialogCloseCallback IO ()
cb
    C_DialogCloseCallback -> IO (FunPtr C_DialogCloseCallback)
mk_DialogCloseCallback C_DialogCloseCallback
cb' IO (FunPtr C_DialogCloseCallback)
-> (FunPtr C_DialogCloseCallback
    -> IO (GClosure C_DialogCloseCallback))
-> IO (GClosure C_DialogCloseCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DialogCloseCallback -> IO (GClosure C_DialogCloseCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DialogCloseCallback` into a `C_DialogCloseCallback`.
wrap_DialogCloseCallback ::
    DialogCloseCallback ->
    C_DialogCloseCallback
wrap_DialogCloseCallback :: IO () -> C_DialogCloseCallback
wrap_DialogCloseCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [close](#signal:close) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' dialog #close callback
-- @
-- 
-- 
onDialogClose :: (IsDialog a, MonadIO m) => a -> DialogCloseCallback -> m SignalHandlerId
onDialogClose :: a -> IO () -> m SignalHandlerId
onDialogClose a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DialogCloseCallback
cb' = IO () -> C_DialogCloseCallback
wrap_DialogCloseCallback IO ()
cb
    FunPtr C_DialogCloseCallback
cb'' <- C_DialogCloseCallback -> IO (FunPtr C_DialogCloseCallback)
mk_DialogCloseCallback C_DialogCloseCallback
cb'
    a
-> Text
-> FunPtr C_DialogCloseCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"close" FunPtr C_DialogCloseCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [close](#signal:close) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' dialog #close callback
-- @
-- 
-- 
afterDialogClose :: (IsDialog a, MonadIO m) => a -> DialogCloseCallback -> m SignalHandlerId
afterDialogClose :: a -> IO () -> m SignalHandlerId
afterDialogClose a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DialogCloseCallback
cb' = IO () -> C_DialogCloseCallback
wrap_DialogCloseCallback IO ()
cb
    FunPtr C_DialogCloseCallback
cb'' <- C_DialogCloseCallback -> IO (FunPtr C_DialogCloseCallback)
mk_DialogCloseCallback C_DialogCloseCallback
cb'
    a
-> Text
-> FunPtr C_DialogCloseCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"close" FunPtr C_DialogCloseCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DialogCloseSignalInfo
instance SignalInfo DialogCloseSignalInfo where
    type HaskellCallbackType DialogCloseSignalInfo = DialogCloseCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DialogCloseCallback cb
        cb'' <- mk_DialogCloseCallback cb'
        connectSignalFunPtr obj "close" cb'' connectMode detail

#endif

-- signal Dialog::response
-- | Emitted when an action widget is clicked, the dialog receives a
-- delete event, or the application programmer calls 'GI.Gtk.Objects.Dialog.dialogResponse'.
-- On a delete event, the response ID is @/GTK_RESPONSE_DELETE_EVENT/@.
-- Otherwise, it depends on which action widget was clicked.
type DialogResponseCallback =
    Int32
    -- ^ /@responseId@/: the response ID
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `DialogResponseCallback`@.
noDialogResponseCallback :: Maybe DialogResponseCallback
noDialogResponseCallback :: Maybe DialogResponseCallback
noDialogResponseCallback = Maybe DialogResponseCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_DialogResponseCallback =
    Ptr () ->                               -- object
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_DialogResponse :: MonadIO m => DialogResponseCallback -> m (GClosure C_DialogResponseCallback)
genClosure_DialogResponse :: DialogResponseCallback -> m (GClosure C_DialogResponseCallback)
genClosure_DialogResponse DialogResponseCallback
cb = IO (GClosure C_DialogResponseCallback)
-> m (GClosure C_DialogResponseCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DialogResponseCallback)
 -> m (GClosure C_DialogResponseCallback))
-> IO (GClosure C_DialogResponseCallback)
-> m (GClosure C_DialogResponseCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DialogResponseCallback
cb' = DialogResponseCallback -> C_DialogResponseCallback
wrap_DialogResponseCallback DialogResponseCallback
cb
    C_DialogResponseCallback -> IO (FunPtr C_DialogResponseCallback)
mk_DialogResponseCallback C_DialogResponseCallback
cb' IO (FunPtr C_DialogResponseCallback)
-> (FunPtr C_DialogResponseCallback
    -> IO (GClosure C_DialogResponseCallback))
-> IO (GClosure C_DialogResponseCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DialogResponseCallback
-> IO (GClosure C_DialogResponseCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DialogResponseCallback` into a `C_DialogResponseCallback`.
wrap_DialogResponseCallback ::
    DialogResponseCallback ->
    C_DialogResponseCallback
wrap_DialogResponseCallback :: DialogResponseCallback -> C_DialogResponseCallback
wrap_DialogResponseCallback DialogResponseCallback
_cb Ptr ()
_ Int32
responseId Ptr ()
_ = do
    DialogResponseCallback
_cb  Int32
responseId


-- | Connect a signal handler for the [response](#signal:response) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' dialog #response callback
-- @
-- 
-- 
onDialogResponse :: (IsDialog a, MonadIO m) => a -> DialogResponseCallback -> m SignalHandlerId
onDialogResponse :: a -> DialogResponseCallback -> m SignalHandlerId
onDialogResponse a
obj DialogResponseCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DialogResponseCallback
cb' = DialogResponseCallback -> C_DialogResponseCallback
wrap_DialogResponseCallback DialogResponseCallback
cb
    FunPtr C_DialogResponseCallback
cb'' <- C_DialogResponseCallback -> IO (FunPtr C_DialogResponseCallback)
mk_DialogResponseCallback C_DialogResponseCallback
cb'
    a
-> Text
-> FunPtr C_DialogResponseCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"response" FunPtr C_DialogResponseCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [response](#signal:response) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' dialog #response callback
-- @
-- 
-- 
afterDialogResponse :: (IsDialog a, MonadIO m) => a -> DialogResponseCallback -> m SignalHandlerId
afterDialogResponse :: a -> DialogResponseCallback -> m SignalHandlerId
afterDialogResponse a
obj DialogResponseCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DialogResponseCallback
cb' = DialogResponseCallback -> C_DialogResponseCallback
wrap_DialogResponseCallback DialogResponseCallback
cb
    FunPtr C_DialogResponseCallback
cb'' <- C_DialogResponseCallback -> IO (FunPtr C_DialogResponseCallback)
mk_DialogResponseCallback C_DialogResponseCallback
cb'
    a
-> Text
-> FunPtr C_DialogResponseCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"response" FunPtr C_DialogResponseCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DialogResponseSignalInfo
instance SignalInfo DialogResponseSignalInfo where
    type HaskellCallbackType DialogResponseSignalInfo = DialogResponseCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DialogResponseCallback cb
        cb'' <- mk_DialogResponseCallback cb'
        connectSignalFunPtr obj "response" cb'' connectMode detail

#endif

-- VVV Prop "use-header-bar"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@use-header-bar@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDialogUseHeaderBar :: (IsDialog o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructDialogUseHeaderBar :: Int32 -> m (GValueConstruct o)
constructDialogUseHeaderBar Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"use-header-bar" Int32
val

#if defined(ENABLE_OVERLOADING)
data DialogUseHeaderBarPropertyInfo
instance AttrInfo DialogUseHeaderBarPropertyInfo where
    type AttrAllowedOps DialogUseHeaderBarPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DialogUseHeaderBarPropertyInfo = IsDialog
    type AttrSetTypeConstraint DialogUseHeaderBarPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint DialogUseHeaderBarPropertyInfo = (~) Int32
    type AttrTransferType DialogUseHeaderBarPropertyInfo = Int32
    type AttrGetType DialogUseHeaderBarPropertyInfo = Int32
    type AttrLabel DialogUseHeaderBarPropertyInfo = "use-header-bar"
    type AttrOrigin DialogUseHeaderBarPropertyInfo = Dialog
    attrGet = getDialogUseHeaderBar
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDialogUseHeaderBar
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Dialog
type instance O.AttributeList Dialog = DialogAttributeList
type DialogAttributeList = ('[ '("application", Gtk.Window.WindowApplicationPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("child", Gtk.Window.WindowChildPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("decorated", Gtk.Window.WindowDecoratedPropertyInfo), '("defaultHeight", Gtk.Window.WindowDefaultHeightPropertyInfo), '("defaultWidget", Gtk.Window.WindowDefaultWidgetPropertyInfo), '("defaultWidth", Gtk.Window.WindowDefaultWidthPropertyInfo), '("deletable", Gtk.Window.WindowDeletablePropertyInfo), '("destroyWithParent", Gtk.Window.WindowDestroyWithParentPropertyInfo), '("display", Gtk.Window.WindowDisplayPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusVisible", Gtk.Window.WindowFocusVisiblePropertyInfo), '("focusWidget", Gtk.Window.WindowFocusWidgetPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("hideOnClose", Gtk.Window.WindowHideOnClosePropertyInfo), '("iconName", Gtk.Window.WindowIconNamePropertyInfo), '("isActive", Gtk.Window.WindowIsActivePropertyInfo), '("isMaximized", Gtk.Window.WindowIsMaximizedPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("mnemonicsVisible", Gtk.Window.WindowMnemonicsVisiblePropertyInfo), '("modal", Gtk.Window.WindowModalPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("resizable", Gtk.Window.WindowResizablePropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("startupId", Gtk.Window.WindowStartupIdPropertyInfo), '("title", Gtk.Window.WindowTitlePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("transientFor", Gtk.Window.WindowTransientForPropertyInfo), '("useHeaderBar", DialogUseHeaderBarPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dialogUseHeaderBar :: AttrLabelProxy "useHeaderBar"
dialogUseHeaderBar = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Dialog = DialogSignalList
type DialogSignalList = ('[ '("activateDefault", Gtk.Window.WindowActivateDefaultSignalInfo), '("activateFocus", Gtk.Window.WindowActivateFocusSignalInfo), '("close", DialogCloseSignalInfo), '("closeRequest", Gtk.Window.WindowCloseRequestSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("enableDebugging", Gtk.Window.WindowEnableDebuggingSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("keysChanged", Gtk.Window.WindowKeysChangedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("response", DialogResponseSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_dialog_new" gtk_dialog_new :: 
    IO (Ptr Dialog)

-- | Creates a new dialog box.
-- 
-- Widgets should not be packed into this t'GI.Gtk.Objects.Window.Window'
-- directly, but into the /@contentArea@/ and /@actionArea@/, as described above.
dialogNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Dialog
    -- ^ __Returns:__ the new dialog as a t'GI.Gtk.Objects.Widget.Widget'
dialogNew :: m Dialog
dialogNew  = IO Dialog -> m Dialog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Dialog -> m Dialog) -> IO Dialog -> m Dialog
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dialog
result <- IO (Ptr Dialog)
gtk_dialog_new
    Text -> Ptr Dialog -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dialogNew" Ptr Dialog
result
    Dialog
result' <- ((ManagedPtr Dialog -> Dialog) -> Ptr Dialog -> IO Dialog
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Dialog -> Dialog
Dialog) Ptr Dialog
result
    Dialog -> IO Dialog
forall (m :: * -> *) a. Monad m => a -> m a
return Dialog
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Dialog::add_action_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dialog"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Dialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an activatable widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "response_id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "response ID for @child"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_dialog_add_action_widget" gtk_dialog_add_action_widget :: 
    Ptr Dialog ->                           -- dialog : TInterface (Name {namespace = "Gtk", name = "Dialog"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    Int32 ->                                -- response_id : TBasicType TInt
    IO ()

-- | Adds an activatable widget to the action area of a t'GI.Gtk.Objects.Dialog.Dialog',
-- connecting a signal handler that will emit the [response]("GI.Gtk.Objects.Dialog#g:signal:response")
-- signal on the dialog when the widget is activated. The widget is
-- appended to the end of the dialog’s action area. If you want to add a
-- non-activatable widget, simply pack it into the /@actionArea@/ field
-- of the t'GI.Gtk.Objects.Dialog.Dialog' struct.
dialogAddActionWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsDialog a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@dialog@/: a t'GI.Gtk.Objects.Dialog.Dialog'
    -> b
    -- ^ /@child@/: an activatable widget
    -> Int32
    -- ^ /@responseId@/: response ID for /@child@/
    -> m ()
dialogAddActionWidget :: a -> b -> Int32 -> m ()
dialogAddActionWidget a
dialog b
child Int32
responseId = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dialog
dialog' <- a -> IO (Ptr Dialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dialog
    Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr Dialog -> Ptr Widget -> DialogResponseCallback
gtk_dialog_add_action_widget Ptr Dialog
dialog' Ptr Widget
child' Int32
responseId
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dialog
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DialogAddActionWidgetMethodInfo
instance (signature ~ (b -> Int32 -> m ()), MonadIO m, IsDialog a, Gtk.Widget.IsWidget b) => O.MethodInfo DialogAddActionWidgetMethodInfo a signature where
    overloadedMethod = dialogAddActionWidget

#endif

-- method Dialog::add_button
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dialog"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Dialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button_text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "text of button" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "response_id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "response ID for the button"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Widget" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_dialog_add_button" gtk_dialog_add_button :: 
    Ptr Dialog ->                           -- dialog : TInterface (Name {namespace = "Gtk", name = "Dialog"})
    CString ->                              -- button_text : TBasicType TUTF8
    Int32 ->                                -- response_id : TBasicType TInt
    IO (Ptr Gtk.Widget.Widget)

-- | Adds a button with the given text and sets things up so that
-- clicking the button will emit the [response]("GI.Gtk.Objects.Dialog#g:signal:response") signal with
-- the given /@responseId@/. The button is appended to the end of the
-- dialog’s action area. The button widget is returned, but usually
-- you don’t need it.
dialogAddButton ::
    (B.CallStack.HasCallStack, MonadIO m, IsDialog a) =>
    a
    -- ^ /@dialog@/: a t'GI.Gtk.Objects.Dialog.Dialog'
    -> T.Text
    -- ^ /@buttonText@/: text of button
    -> Int32
    -- ^ /@responseId@/: response ID for the button
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ the t'GI.Gtk.Objects.Button.Button' widget that was added
dialogAddButton :: a -> Text -> Int32 -> m Widget
dialogAddButton a
dialog Text
buttonText Int32
responseId = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dialog
dialog' <- a -> IO (Ptr Dialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dialog
    CString
buttonText' <- Text -> IO CString
textToCString Text
buttonText
    Ptr Widget
result <- Ptr Dialog -> CString -> Int32 -> IO (Ptr Widget)
gtk_dialog_add_button Ptr Dialog
dialog' CString
buttonText' Int32
responseId
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dialogAddButton" Ptr Widget
result
    Widget
result' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dialog
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
buttonText'
    Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
data DialogAddButtonMethodInfo
instance (signature ~ (T.Text -> Int32 -> m Gtk.Widget.Widget), MonadIO m, IsDialog a) => O.MethodInfo DialogAddButtonMethodInfo a signature where
    overloadedMethod = dialogAddButton

#endif

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

foreign import ccall "gtk_dialog_get_content_area" gtk_dialog_get_content_area :: 
    Ptr Dialog ->                           -- dialog : TInterface (Name {namespace = "Gtk", name = "Dialog"})
    IO (Ptr Gtk.Box.Box)

-- | Returns the content area of /@dialog@/.
dialogGetContentArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsDialog a) =>
    a
    -- ^ /@dialog@/: a t'GI.Gtk.Objects.Dialog.Dialog'
    -> m Gtk.Box.Box
    -- ^ __Returns:__ the content area t'GI.Gtk.Objects.Box.Box'.
dialogGetContentArea :: a -> m Box
dialogGetContentArea a
dialog = IO Box -> m Box
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Box -> m Box) -> IO Box -> m Box
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dialog
dialog' <- a -> IO (Ptr Dialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dialog
    Ptr Box
result <- Ptr Dialog -> IO (Ptr Box)
gtk_dialog_get_content_area Ptr Dialog
dialog'
    Text -> Ptr Box -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dialogGetContentArea" Ptr Box
result
    Box
result' <- ((ManagedPtr Box -> Box) -> Ptr Box -> IO Box
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Box -> Box
Gtk.Box.Box) Ptr Box
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dialog
    Box -> IO Box
forall (m :: * -> *) a. Monad m => a -> m a
return Box
result'

#if defined(ENABLE_OVERLOADING)
data DialogGetContentAreaMethodInfo
instance (signature ~ (m Gtk.Box.Box), MonadIO m, IsDialog a) => O.MethodInfo DialogGetContentAreaMethodInfo a signature where
    overloadedMethod = dialogGetContentArea

#endif

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

foreign import ccall "gtk_dialog_get_header_bar" gtk_dialog_get_header_bar :: 
    Ptr Dialog ->                           -- dialog : TInterface (Name {namespace = "Gtk", name = "Dialog"})
    IO (Ptr Gtk.HeaderBar.HeaderBar)

-- | Returns the header bar of /@dialog@/. Note that the
-- headerbar is only used by the dialog if the
-- t'GI.Gtk.Objects.Dialog.Dialog':@/use-header-bar/@ property is 'P.True'.
dialogGetHeaderBar ::
    (B.CallStack.HasCallStack, MonadIO m, IsDialog a) =>
    a
    -- ^ /@dialog@/: a t'GI.Gtk.Objects.Dialog.Dialog'
    -> m Gtk.HeaderBar.HeaderBar
    -- ^ __Returns:__ the header bar
dialogGetHeaderBar :: a -> m HeaderBar
dialogGetHeaderBar a
dialog = IO HeaderBar -> m HeaderBar
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HeaderBar -> m HeaderBar) -> IO HeaderBar -> m HeaderBar
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dialog
dialog' <- a -> IO (Ptr Dialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dialog
    Ptr HeaderBar
result <- Ptr Dialog -> IO (Ptr HeaderBar)
gtk_dialog_get_header_bar Ptr Dialog
dialog'
    Text -> Ptr HeaderBar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dialogGetHeaderBar" Ptr HeaderBar
result
    HeaderBar
result' <- ((ManagedPtr HeaderBar -> HeaderBar)
-> Ptr HeaderBar -> IO HeaderBar
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr HeaderBar -> HeaderBar
Gtk.HeaderBar.HeaderBar) Ptr HeaderBar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dialog
    HeaderBar -> IO HeaderBar
forall (m :: * -> *) a. Monad m => a -> m a
return HeaderBar
result'

#if defined(ENABLE_OVERLOADING)
data DialogGetHeaderBarMethodInfo
instance (signature ~ (m Gtk.HeaderBar.HeaderBar), MonadIO m, IsDialog a) => O.MethodInfo DialogGetHeaderBarMethodInfo a signature where
    overloadedMethod = dialogGetHeaderBar

#endif

-- method Dialog::get_response_for_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dialog"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Dialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a widget in the action area of @dialog"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_dialog_get_response_for_widget" gtk_dialog_get_response_for_widget :: 
    Ptr Dialog ->                           -- dialog : TInterface (Name {namespace = "Gtk", name = "Dialog"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO Int32

-- | Gets the response id of a widget in the action area
-- of a dialog.
dialogGetResponseForWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsDialog a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@dialog@/: a t'GI.Gtk.Objects.Dialog.Dialog'
    -> b
    -- ^ /@widget@/: a widget in the action area of /@dialog@/
    -> m Int32
    -- ^ __Returns:__ the response id of /@widget@/, or 'GI.Gtk.Enums.ResponseTypeNone'
    --  if /@widget@/ doesn’t have a response id set.
dialogGetResponseForWidget :: a -> b -> m Int32
dialogGetResponseForWidget a
dialog b
widget = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dialog
dialog' <- a -> IO (Ptr Dialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dialog
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    Int32
result <- Ptr Dialog -> Ptr Widget -> IO Int32
gtk_dialog_get_response_for_widget Ptr Dialog
dialog' Ptr Widget
widget'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dialog
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DialogGetResponseForWidgetMethodInfo
instance (signature ~ (b -> m Int32), MonadIO m, IsDialog a, Gtk.Widget.IsWidget b) => O.MethodInfo DialogGetResponseForWidgetMethodInfo a signature where
    overloadedMethod = dialogGetResponseForWidget

#endif

-- method Dialog::get_widget_for_response
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dialog"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Dialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "response_id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the response ID used by the @dialog widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Widget" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_dialog_get_widget_for_response" gtk_dialog_get_widget_for_response :: 
    Ptr Dialog ->                           -- dialog : TInterface (Name {namespace = "Gtk", name = "Dialog"})
    Int32 ->                                -- response_id : TBasicType TInt
    IO (Ptr Gtk.Widget.Widget)

-- | Gets the widget button that uses the given response ID in the action area
-- of a dialog.
dialogGetWidgetForResponse ::
    (B.CallStack.HasCallStack, MonadIO m, IsDialog a) =>
    a
    -- ^ /@dialog@/: a t'GI.Gtk.Objects.Dialog.Dialog'
    -> Int32
    -- ^ /@responseId@/: the response ID used by the /@dialog@/ widget
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ the /@widget@/ button that uses the given
    --     /@responseId@/, or 'P.Nothing'.
dialogGetWidgetForResponse :: a -> Int32 -> m (Maybe Widget)
dialogGetWidgetForResponse a
dialog Int32
responseId = IO (Maybe Widget) -> m (Maybe Widget)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dialog
dialog' <- a -> IO (Ptr Dialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dialog
    Ptr Widget
result <- Ptr Dialog -> Int32 -> IO (Ptr Widget)
gtk_dialog_get_widget_for_response Ptr Dialog
dialog' Int32
responseId
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dialog
    Maybe Widget -> IO (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data DialogGetWidgetForResponseMethodInfo
instance (signature ~ (Int32 -> m (Maybe Gtk.Widget.Widget)), MonadIO m, IsDialog a) => O.MethodInfo DialogGetWidgetForResponseMethodInfo a signature where
    overloadedMethod = dialogGetWidgetForResponse

#endif

-- method Dialog::response
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dialog"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Dialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "response_id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "response ID" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_dialog_response" gtk_dialog_response :: 
    Ptr Dialog ->                           -- dialog : TInterface (Name {namespace = "Gtk", name = "Dialog"})
    Int32 ->                                -- response_id : TBasicType TInt
    IO ()

-- | Emits the [response]("GI.Gtk.Objects.Dialog#g:signal:response") signal with the given response ID.
-- 
-- Used to indicate that the user has responded to the dialog in some way.
dialogResponse ::
    (B.CallStack.HasCallStack, MonadIO m, IsDialog a) =>
    a
    -- ^ /@dialog@/: a t'GI.Gtk.Objects.Dialog.Dialog'
    -> Int32
    -- ^ /@responseId@/: response ID
    -> m ()
dialogResponse :: a -> Int32 -> m ()
dialogResponse a
dialog Int32
responseId = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dialog
dialog' <- a -> IO (Ptr Dialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dialog
    Ptr Dialog -> DialogResponseCallback
gtk_dialog_response Ptr Dialog
dialog' Int32
responseId
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dialog
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DialogResponseMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsDialog a) => O.MethodInfo DialogResponseMethodInfo a signature where
    overloadedMethod = dialogResponse

#endif

-- method Dialog::set_default_response
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dialog"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Dialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "response_id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a response ID" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_dialog_set_default_response" gtk_dialog_set_default_response :: 
    Ptr Dialog ->                           -- dialog : TInterface (Name {namespace = "Gtk", name = "Dialog"})
    Int32 ->                                -- response_id : TBasicType TInt
    IO ()

-- | Sets the last widget in the dialog’s action area with the given /@responseId@/
-- as the default widget for the dialog. Pressing “Enter” normally activates
-- the default widget.
dialogSetDefaultResponse ::
    (B.CallStack.HasCallStack, MonadIO m, IsDialog a) =>
    a
    -- ^ /@dialog@/: a t'GI.Gtk.Objects.Dialog.Dialog'
    -> Int32
    -- ^ /@responseId@/: a response ID
    -> m ()
dialogSetDefaultResponse :: a -> Int32 -> m ()
dialogSetDefaultResponse a
dialog Int32
responseId = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dialog
dialog' <- a -> IO (Ptr Dialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dialog
    Ptr Dialog -> DialogResponseCallback
gtk_dialog_set_default_response Ptr Dialog
dialog' Int32
responseId
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dialog
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DialogSetDefaultResponseMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsDialog a) => O.MethodInfo DialogSetDefaultResponseMethodInfo a signature where
    overloadedMethod = dialogSetDefaultResponse

#endif

-- method Dialog::set_response_sensitive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dialog"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Dialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "response_id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a response ID" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "setting"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE for sensitive"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_dialog_set_response_sensitive" gtk_dialog_set_response_sensitive :: 
    Ptr Dialog ->                           -- dialog : TInterface (Name {namespace = "Gtk", name = "Dialog"})
    Int32 ->                                -- response_id : TBasicType TInt
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()

-- | Calls @gtk_widget_set_sensitive (widget, \@setting)@
-- for each widget in the dialog’s action area with the given /@responseId@/.
-- A convenient way to sensitize\/desensitize dialog buttons.
dialogSetResponseSensitive ::
    (B.CallStack.HasCallStack, MonadIO m, IsDialog a) =>
    a
    -- ^ /@dialog@/: a t'GI.Gtk.Objects.Dialog.Dialog'
    -> Int32
    -- ^ /@responseId@/: a response ID
    -> Bool
    -- ^ /@setting@/: 'P.True' for sensitive
    -> m ()
dialogSetResponseSensitive :: a -> Int32 -> Bool -> m ()
dialogSetResponseSensitive a
dialog Int32
responseId Bool
setting = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dialog
dialog' <- a -> IO (Ptr Dialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dialog
    let setting' :: CInt
setting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
setting
    Ptr Dialog -> Int32 -> CInt -> IO ()
gtk_dialog_set_response_sensitive Ptr Dialog
dialog' Int32
responseId CInt
setting'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dialog
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DialogSetResponseSensitiveMethodInfo
instance (signature ~ (Int32 -> Bool -> m ()), MonadIO m, IsDialog a) => O.MethodInfo DialogSetResponseSensitiveMethodInfo a signature where
    overloadedMethod = dialogSetResponseSensitive

#endif