{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Atk.Interfaces.Window.Window' should be implemented by the UI elements that represent
-- a top-level window, such as the main window of an application or
-- dialog.

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

module GI.Atk.Interfaces.Window
    ( 

-- * Exported types
    Window(..)                              ,
    IsWindow                                ,
    toWindow                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addRelationship]("GI.Atk.Objects.Object#g:method:addRelationship"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [initialize]("GI.Atk.Objects.Object#g:method:initialize"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [notifyStateChange]("GI.Atk.Objects.Object#g:method:notifyStateChange"), [peekParent]("GI.Atk.Objects.Object#g:method:peekParent"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refAccessibleChild]("GI.Atk.Objects.Object#g:method:refAccessibleChild"), [refRelationSet]("GI.Atk.Objects.Object#g:method:refRelationSet"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [refStateSet]("GI.Atk.Objects.Object#g:method:refStateSet"), [removePropertyChangeHandler]("GI.Atk.Objects.Object#g:method:removePropertyChangeHandler"), [removeRelationship]("GI.Atk.Objects.Object#g:method:removeRelationship"), [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
-- [getAccessibleId]("GI.Atk.Objects.Object#g:method:getAccessibleId"), [getAttributes]("GI.Atk.Objects.Object#g:method:getAttributes"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDescription]("GI.Atk.Objects.Object#g:method:getDescription"), [getIndexInParent]("GI.Atk.Objects.Object#g:method:getIndexInParent"), [getLayer]("GI.Atk.Objects.Object#g:method:getLayer"), [getMdiZorder]("GI.Atk.Objects.Object#g:method:getMdiZorder"), [getNAccessibleChildren]("GI.Atk.Objects.Object#g:method:getNAccessibleChildren"), [getName]("GI.Atk.Objects.Object#g:method:getName"), [getObjectLocale]("GI.Atk.Objects.Object#g:method:getObjectLocale"), [getParent]("GI.Atk.Objects.Object#g:method:getParent"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRole]("GI.Atk.Objects.Object#g:method:getRole").
-- 
-- ==== Setters
-- [setAccessibleId]("GI.Atk.Objects.Object#g:method:setAccessibleId"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDescription]("GI.Atk.Objects.Object#g:method:setDescription"), [setName]("GI.Atk.Objects.Object#g:method:setName"), [setParent]("GI.Atk.Objects.Object#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRole]("GI.Atk.Objects.Object#g:method:setRole").

#if defined(ENABLE_OVERLOADING)
    ResolveWindowMethod                     ,
#endif



 -- * Signals


-- ** activate #signal:activate#

    WindowActivateCallback                  ,
#if defined(ENABLE_OVERLOADING)
    WindowActivateSignalInfo                ,
#endif
    afterWindowActivate                     ,
    onWindowActivate                        ,


-- ** create #signal:create#

    WindowCreateCallback                    ,
#if defined(ENABLE_OVERLOADING)
    WindowCreateSignalInfo                  ,
#endif
    afterWindowCreate                       ,
    onWindowCreate                          ,


-- ** deactivate #signal:deactivate#

    WindowDeactivateCallback                ,
#if defined(ENABLE_OVERLOADING)
    WindowDeactivateSignalInfo              ,
#endif
    afterWindowDeactivate                   ,
    onWindowDeactivate                      ,


-- ** destroy #signal:destroy#

    WindowDestroyCallback                   ,
#if defined(ENABLE_OVERLOADING)
    WindowDestroySignalInfo                 ,
#endif
    afterWindowDestroy                      ,
    onWindowDestroy                         ,


-- ** maximize #signal:maximize#

    WindowMaximizeCallback                  ,
#if defined(ENABLE_OVERLOADING)
    WindowMaximizeSignalInfo                ,
#endif
    afterWindowMaximize                     ,
    onWindowMaximize                        ,


-- ** minimize #signal:minimize#

    WindowMinimizeCallback                  ,
#if defined(ENABLE_OVERLOADING)
    WindowMinimizeSignalInfo                ,
#endif
    afterWindowMinimize                     ,
    onWindowMinimize                        ,


-- ** move #signal:move#

    WindowMoveCallback                      ,
#if defined(ENABLE_OVERLOADING)
    WindowMoveSignalInfo                    ,
#endif
    afterWindowMove                         ,
    onWindowMove                            ,


-- ** resize #signal:resize#

    WindowResizeCallback                    ,
#if defined(ENABLE_OVERLOADING)
    WindowResizeSignalInfo                  ,
#endif
    afterWindowResize                       ,
    onWindowResize                          ,


-- ** restore #signal:restore#

    WindowRestoreCallback                   ,
#if defined(ENABLE_OVERLOADING)
    WindowRestoreSignalInfo                 ,
#endif
    afterWindowRestore                      ,
    onWindowRestore                         ,




    ) 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.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.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 {-# SOURCE #-} qualified GI.Atk.Objects.Object as Atk.Object
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "atk_window_get_type"
    c_atk_window_get_type :: IO B.Types.GType

instance B.Types.TypedObject Window where
    glibType :: IO GType
glibType = IO GType
c_atk_window_get_type

instance B.Types.GObject Window

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

instance O.HasParentTypes Window
type instance O.ParentTypes Window = '[GObject.Object.Object, Atk.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Window
type instance O.AttributeList Window = WindowAttributeList
type WindowAttributeList = ('[ '("accessibleComponentLayer", Atk.Object.ObjectAccessibleComponentLayerPropertyInfo), '("accessibleComponentMdiZorder", Atk.Object.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessibleDescription", Atk.Object.ObjectAccessibleDescriptionPropertyInfo), '("accessibleHypertextNlinks", Atk.Object.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessibleName", Atk.Object.ObjectAccessibleNamePropertyInfo), '("accessibleParent", Atk.Object.ObjectAccessibleParentPropertyInfo), '("accessibleRole", Atk.Object.ObjectAccessibleRolePropertyInfo), '("accessibleTableCaption", Atk.Object.ObjectAccessibleTableCaptionPropertyInfo), '("accessibleTableCaptionObject", Atk.Object.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessibleTableColumnDescription", Atk.Object.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessibleTableColumnHeader", Atk.Object.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessibleTableRowDescription", Atk.Object.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessibleTableRowHeader", Atk.Object.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessibleTableSummary", Atk.Object.ObjectAccessibleTableSummaryPropertyInfo), '("accessibleValue", Atk.Object.ObjectAccessibleValuePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveWindowMethod (t :: Symbol) (o :: *) :: * where
    ResolveWindowMethod "addRelationship" o = Atk.Object.ObjectAddRelationshipMethodInfo
    ResolveWindowMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveWindowMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveWindowMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveWindowMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveWindowMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveWindowMethod "initialize" o = Atk.Object.ObjectInitializeMethodInfo
    ResolveWindowMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveWindowMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveWindowMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveWindowMethod "notifyStateChange" o = Atk.Object.ObjectNotifyStateChangeMethodInfo
    ResolveWindowMethod "peekParent" o = Atk.Object.ObjectPeekParentMethodInfo
    ResolveWindowMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveWindowMethod "refAccessibleChild" o = Atk.Object.ObjectRefAccessibleChildMethodInfo
    ResolveWindowMethod "refRelationSet" o = Atk.Object.ObjectRefRelationSetMethodInfo
    ResolveWindowMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveWindowMethod "refStateSet" o = Atk.Object.ObjectRefStateSetMethodInfo
    ResolveWindowMethod "removePropertyChangeHandler" o = Atk.Object.ObjectRemovePropertyChangeHandlerMethodInfo
    ResolveWindowMethod "removeRelationship" o = Atk.Object.ObjectRemoveRelationshipMethodInfo
    ResolveWindowMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveWindowMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveWindowMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveWindowMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveWindowMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveWindowMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveWindowMethod "getAccessibleId" o = Atk.Object.ObjectGetAccessibleIdMethodInfo
    ResolveWindowMethod "getAttributes" o = Atk.Object.ObjectGetAttributesMethodInfo
    ResolveWindowMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveWindowMethod "getDescription" o = Atk.Object.ObjectGetDescriptionMethodInfo
    ResolveWindowMethod "getIndexInParent" o = Atk.Object.ObjectGetIndexInParentMethodInfo
    ResolveWindowMethod "getLayer" o = Atk.Object.ObjectGetLayerMethodInfo
    ResolveWindowMethod "getMdiZorder" o = Atk.Object.ObjectGetMdiZorderMethodInfo
    ResolveWindowMethod "getNAccessibleChildren" o = Atk.Object.ObjectGetNAccessibleChildrenMethodInfo
    ResolveWindowMethod "getName" o = Atk.Object.ObjectGetNameMethodInfo
    ResolveWindowMethod "getObjectLocale" o = Atk.Object.ObjectGetObjectLocaleMethodInfo
    ResolveWindowMethod "getParent" o = Atk.Object.ObjectGetParentMethodInfo
    ResolveWindowMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveWindowMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveWindowMethod "getRole" o = Atk.Object.ObjectGetRoleMethodInfo
    ResolveWindowMethod "setAccessibleId" o = Atk.Object.ObjectSetAccessibleIdMethodInfo
    ResolveWindowMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveWindowMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveWindowMethod "setDescription" o = Atk.Object.ObjectSetDescriptionMethodInfo
    ResolveWindowMethod "setName" o = Atk.Object.ObjectSetNameMethodInfo
    ResolveWindowMethod "setParent" o = Atk.Object.ObjectSetParentMethodInfo
    ResolveWindowMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveWindowMethod "setRole" o = Atk.Object.ObjectSetRoleMethodInfo
    ResolveWindowMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveWindowMethod t Window, O.OverloadedMethod info Window p) => OL.IsLabel t (Window -> 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 ~ ResolveWindowMethod t Window, O.OverloadedMethod info Window p, R.HasField t Window p) => R.HasField t Window p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- signal Window::activate
-- | The signal [Window::activate]("GI.Atk.Interfaces.Window#g:signal:activate") is emitted when a window
-- becomes the active window of the application or session.
-- 
-- /Since: 2.2/
type WindowActivateCallback =
    IO ()

type C_WindowActivateCallback =
    Ptr Window ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WindowActivateCallback :: 
    GObject a => (a -> WindowActivateCallback) ->
    C_WindowActivateCallback
wrap_WindowActivateCallback :: forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowActivateCallback a -> IO ()
gi'cb Ptr Window
gi'selfPtr Ptr ()
_ = do
    Ptr Window -> (Window -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Window
gi'selfPtr ((Window -> IO ()) -> IO ()) -> (Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Window
gi'self -> a -> IO ()
gi'cb (Window -> a
Coerce.coerce Window
gi'self) 


-- | Connect a signal handler for the [activate](#signal:activate) 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' window #activate callback
-- @
-- 
-- 
onWindowActivate :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowActivateCallback) -> m SignalHandlerId
onWindowActivate :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWindowActivate a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowActivateCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowActivateCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"activate" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [activate](#signal:activate) 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' window #activate callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWindowActivate :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowActivateCallback) -> m SignalHandlerId
afterWindowActivate :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWindowActivate a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowActivateCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowActivateCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"activate" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WindowActivateSignalInfo
instance SignalInfo WindowActivateSignalInfo where
    type HaskellCallbackType WindowActivateSignalInfo = WindowActivateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WindowActivateCallback cb
        cb'' <- mk_WindowActivateCallback cb'
        connectSignalFunPtr obj "activate" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Window::activate"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Window.html#g:signal:activate"})

#endif

-- signal Window::create
-- | The signal [Window::create]("GI.Atk.Interfaces.Window#g:signal:create") is emitted when a new window
-- is created.
-- 
-- /Since: 2.2/
type WindowCreateCallback =
    IO ()

type C_WindowCreateCallback =
    Ptr Window ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WindowCreateCallback :: 
    GObject a => (a -> WindowCreateCallback) ->
    C_WindowCreateCallback
wrap_WindowCreateCallback :: forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowCreateCallback a -> IO ()
gi'cb Ptr Window
gi'selfPtr Ptr ()
_ = do
    Ptr Window -> (Window -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Window
gi'selfPtr ((Window -> IO ()) -> IO ()) -> (Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Window
gi'self -> a -> IO ()
gi'cb (Window -> a
Coerce.coerce Window
gi'self) 


-- | Connect a signal handler for the [create](#signal:create) 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' window #create callback
-- @
-- 
-- 
onWindowCreate :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowCreateCallback) -> m SignalHandlerId
onWindowCreate :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWindowCreate a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowCreateCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowCreateCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"create" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [create](#signal:create) 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' window #create callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWindowCreate :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowCreateCallback) -> m SignalHandlerId
afterWindowCreate :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWindowCreate a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowCreateCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowCreateCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"create" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WindowCreateSignalInfo
instance SignalInfo WindowCreateSignalInfo where
    type HaskellCallbackType WindowCreateSignalInfo = WindowCreateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WindowCreateCallback cb
        cb'' <- mk_WindowCreateCallback cb'
        connectSignalFunPtr obj "create" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Window::create"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Window.html#g:signal:create"})

#endif

-- signal Window::deactivate
-- | The signal [Window::deactivate]("GI.Atk.Interfaces.Window#g:signal:deactivate") is emitted when a window is
-- no longer the active window of the application or session.
-- 
-- /Since: 2.2/
type WindowDeactivateCallback =
    IO ()

type C_WindowDeactivateCallback =
    Ptr Window ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WindowDeactivateCallback :: 
    GObject a => (a -> WindowDeactivateCallback) ->
    C_WindowDeactivateCallback
wrap_WindowDeactivateCallback :: forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowDeactivateCallback a -> IO ()
gi'cb Ptr Window
gi'selfPtr Ptr ()
_ = do
    Ptr Window -> (Window -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Window
gi'selfPtr ((Window -> IO ()) -> IO ()) -> (Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Window
gi'self -> a -> IO ()
gi'cb (Window -> a
Coerce.coerce Window
gi'self) 


-- | Connect a signal handler for the [deactivate](#signal:deactivate) 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' window #deactivate callback
-- @
-- 
-- 
onWindowDeactivate :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowDeactivateCallback) -> m SignalHandlerId
onWindowDeactivate :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWindowDeactivate a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowDeactivateCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowDeactivateCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"deactivate" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deactivate](#signal:deactivate) 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' window #deactivate callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWindowDeactivate :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowDeactivateCallback) -> m SignalHandlerId
afterWindowDeactivate :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWindowDeactivate a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowDeactivateCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowDeactivateCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"deactivate" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WindowDeactivateSignalInfo
instance SignalInfo WindowDeactivateSignalInfo where
    type HaskellCallbackType WindowDeactivateSignalInfo = WindowDeactivateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WindowDeactivateCallback cb
        cb'' <- mk_WindowDeactivateCallback cb'
        connectSignalFunPtr obj "deactivate" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Window::deactivate"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Window.html#g:signal:deactivate"})

#endif

-- signal Window::destroy
-- | The signal [Window::destroy]("GI.Atk.Interfaces.Window#g:signal:destroy") is emitted when a window is
-- destroyed.
-- 
-- /Since: 2.2/
type WindowDestroyCallback =
    IO ()

type C_WindowDestroyCallback =
    Ptr Window ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WindowDestroyCallback :: 
    GObject a => (a -> WindowDestroyCallback) ->
    C_WindowDestroyCallback
wrap_WindowDestroyCallback :: forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowDestroyCallback a -> IO ()
gi'cb Ptr Window
gi'selfPtr Ptr ()
_ = do
    Ptr Window -> (Window -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Window
gi'selfPtr ((Window -> IO ()) -> IO ()) -> (Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Window
gi'self -> a -> IO ()
gi'cb (Window -> a
Coerce.coerce Window
gi'self) 


-- | Connect a signal handler for the [destroy](#signal:destroy) 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' window #destroy callback
-- @
-- 
-- 
onWindowDestroy :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowDestroyCallback) -> m SignalHandlerId
onWindowDestroy :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWindowDestroy a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowDestroyCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowDestroyCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"destroy" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [destroy](#signal:destroy) 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' window #destroy callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWindowDestroy :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowDestroyCallback) -> m SignalHandlerId
afterWindowDestroy :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWindowDestroy a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowDestroyCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowDestroyCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"destroy" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WindowDestroySignalInfo
instance SignalInfo WindowDestroySignalInfo where
    type HaskellCallbackType WindowDestroySignalInfo = WindowDestroyCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WindowDestroyCallback cb
        cb'' <- mk_WindowDestroyCallback cb'
        connectSignalFunPtr obj "destroy" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Window::destroy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Window.html#g:signal:destroy"})

#endif

-- signal Window::maximize
-- | The signal [Window::maximize]("GI.Atk.Interfaces.Window#g:signal:maximize") is emitted when a window
-- is maximized.
-- 
-- /Since: 2.2/
type WindowMaximizeCallback =
    IO ()

type C_WindowMaximizeCallback =
    Ptr Window ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WindowMaximizeCallback :: 
    GObject a => (a -> WindowMaximizeCallback) ->
    C_WindowMaximizeCallback
wrap_WindowMaximizeCallback :: forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowMaximizeCallback a -> IO ()
gi'cb Ptr Window
gi'selfPtr Ptr ()
_ = do
    Ptr Window -> (Window -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Window
gi'selfPtr ((Window -> IO ()) -> IO ()) -> (Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Window
gi'self -> a -> IO ()
gi'cb (Window -> a
Coerce.coerce Window
gi'self) 


-- | Connect a signal handler for the [maximize](#signal:maximize) 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' window #maximize callback
-- @
-- 
-- 
onWindowMaximize :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowMaximizeCallback) -> m SignalHandlerId
onWindowMaximize :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWindowMaximize a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowMaximizeCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowMaximizeCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"maximize" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [maximize](#signal:maximize) 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' window #maximize callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWindowMaximize :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowMaximizeCallback) -> m SignalHandlerId
afterWindowMaximize :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWindowMaximize a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowMaximizeCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowMaximizeCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"maximize" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WindowMaximizeSignalInfo
instance SignalInfo WindowMaximizeSignalInfo where
    type HaskellCallbackType WindowMaximizeSignalInfo = WindowMaximizeCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WindowMaximizeCallback cb
        cb'' <- mk_WindowMaximizeCallback cb'
        connectSignalFunPtr obj "maximize" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Window::maximize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Window.html#g:signal:maximize"})

#endif

-- signal Window::minimize
-- | The signal [Window::minimize]("GI.Atk.Interfaces.Window#g:signal:minimize") is emitted when a window
-- is minimized.
-- 
-- /Since: 2.2/
type WindowMinimizeCallback =
    IO ()

type C_WindowMinimizeCallback =
    Ptr Window ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WindowMinimizeCallback :: 
    GObject a => (a -> WindowMinimizeCallback) ->
    C_WindowMinimizeCallback
wrap_WindowMinimizeCallback :: forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowMinimizeCallback a -> IO ()
gi'cb Ptr Window
gi'selfPtr Ptr ()
_ = do
    Ptr Window -> (Window -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Window
gi'selfPtr ((Window -> IO ()) -> IO ()) -> (Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Window
gi'self -> a -> IO ()
gi'cb (Window -> a
Coerce.coerce Window
gi'self) 


-- | Connect a signal handler for the [minimize](#signal:minimize) 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' window #minimize callback
-- @
-- 
-- 
onWindowMinimize :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowMinimizeCallback) -> m SignalHandlerId
onWindowMinimize :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWindowMinimize a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowMinimizeCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowMinimizeCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"minimize" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [minimize](#signal:minimize) 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' window #minimize callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWindowMinimize :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowMinimizeCallback) -> m SignalHandlerId
afterWindowMinimize :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWindowMinimize a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowMinimizeCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowMinimizeCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"minimize" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WindowMinimizeSignalInfo
instance SignalInfo WindowMinimizeSignalInfo where
    type HaskellCallbackType WindowMinimizeSignalInfo = WindowMinimizeCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WindowMinimizeCallback cb
        cb'' <- mk_WindowMinimizeCallback cb'
        connectSignalFunPtr obj "minimize" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Window::minimize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Window.html#g:signal:minimize"})

#endif

-- signal Window::move
-- | The signal [Window::move]("GI.Atk.Interfaces.Window#g:signal:move") is emitted when a window
-- is moved.
-- 
-- /Since: 2.2/
type WindowMoveCallback =
    IO ()

type C_WindowMoveCallback =
    Ptr Window ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WindowMoveCallback :: 
    GObject a => (a -> WindowMoveCallback) ->
    C_WindowMoveCallback
wrap_WindowMoveCallback :: forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowMoveCallback a -> IO ()
gi'cb Ptr Window
gi'selfPtr Ptr ()
_ = do
    Ptr Window -> (Window -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Window
gi'selfPtr ((Window -> IO ()) -> IO ()) -> (Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Window
gi'self -> a -> IO ()
gi'cb (Window -> a
Coerce.coerce Window
gi'self) 


-- | Connect a signal handler for the [move](#signal:move) 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' window #move callback
-- @
-- 
-- 
onWindowMove :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowMoveCallback) -> m SignalHandlerId
onWindowMove :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWindowMove a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowMoveCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowMoveCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"move" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [move](#signal:move) 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' window #move callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWindowMove :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowMoveCallback) -> m SignalHandlerId
afterWindowMove :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWindowMove a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowMoveCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowMoveCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"move" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WindowMoveSignalInfo
instance SignalInfo WindowMoveSignalInfo where
    type HaskellCallbackType WindowMoveSignalInfo = WindowMoveCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WindowMoveCallback cb
        cb'' <- mk_WindowMoveCallback cb'
        connectSignalFunPtr obj "move" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Window::move"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Window.html#g:signal:move"})

#endif

-- signal Window::resize
-- | The signal [Window::resize]("GI.Atk.Interfaces.Window#g:signal:resize") is emitted when a window
-- is resized.
-- 
-- /Since: 2.2/
type WindowResizeCallback =
    IO ()

type C_WindowResizeCallback =
    Ptr Window ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WindowResizeCallback :: 
    GObject a => (a -> WindowResizeCallback) ->
    C_WindowResizeCallback
wrap_WindowResizeCallback :: forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowResizeCallback a -> IO ()
gi'cb Ptr Window
gi'selfPtr Ptr ()
_ = do
    Ptr Window -> (Window -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Window
gi'selfPtr ((Window -> IO ()) -> IO ()) -> (Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Window
gi'self -> a -> IO ()
gi'cb (Window -> a
Coerce.coerce Window
gi'self) 


-- | Connect a signal handler for the [resize](#signal:resize) 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' window #resize callback
-- @
-- 
-- 
onWindowResize :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowResizeCallback) -> m SignalHandlerId
onWindowResize :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWindowResize a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowResizeCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowResizeCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"resize" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [resize](#signal:resize) 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' window #resize callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWindowResize :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowResizeCallback) -> m SignalHandlerId
afterWindowResize :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWindowResize a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowResizeCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowResizeCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"resize" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WindowResizeSignalInfo
instance SignalInfo WindowResizeSignalInfo where
    type HaskellCallbackType WindowResizeSignalInfo = WindowResizeCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WindowResizeCallback cb
        cb'' <- mk_WindowResizeCallback cb'
        connectSignalFunPtr obj "resize" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Window::resize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Window.html#g:signal:resize"})

#endif

-- signal Window::restore
-- | The signal [Window::restore]("GI.Atk.Interfaces.Window#g:signal:restore") is emitted when a window
-- is restored.
-- 
-- /Since: 2.2/
type WindowRestoreCallback =
    IO ()

type C_WindowRestoreCallback =
    Ptr Window ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WindowRestoreCallback :: 
    GObject a => (a -> WindowRestoreCallback) ->
    C_WindowRestoreCallback
wrap_WindowRestoreCallback :: forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowRestoreCallback a -> IO ()
gi'cb Ptr Window
gi'selfPtr Ptr ()
_ = do
    Ptr Window -> (Window -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Window
gi'selfPtr ((Window -> IO ()) -> IO ()) -> (Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Window
gi'self -> a -> IO ()
gi'cb (Window -> a
Coerce.coerce Window
gi'self) 


-- | Connect a signal handler for the [restore](#signal:restore) 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' window #restore callback
-- @
-- 
-- 
onWindowRestore :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowRestoreCallback) -> m SignalHandlerId
onWindowRestore :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWindowRestore a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowRestoreCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowRestoreCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"restore" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [restore](#signal:restore) 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' window #restore callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWindowRestore :: (IsWindow a, MonadIO m) => a -> ((?self :: a) => WindowRestoreCallback) -> m SignalHandlerId
afterWindowRestore :: forall a (m :: * -> *).
(IsWindow a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWindowRestore a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WindowActivateCallback
wrapped' = (a -> IO ()) -> C_WindowActivateCallback
forall a. GObject a => (a -> IO ()) -> C_WindowActivateCallback
wrap_WindowRestoreCallback a -> IO ()
wrapped
    FunPtr C_WindowActivateCallback
wrapped'' <- C_WindowActivateCallback -> IO (FunPtr C_WindowActivateCallback)
mk_WindowRestoreCallback C_WindowActivateCallback
wrapped'
    a
-> Text
-> FunPtr C_WindowActivateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"restore" FunPtr C_WindowActivateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WindowRestoreSignalInfo
instance SignalInfo WindowRestoreSignalInfo where
    type HaskellCallbackType WindowRestoreSignalInfo = WindowRestoreCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WindowRestoreCallback cb
        cb'' <- mk_WindowRestoreCallback cb'
        connectSignalFunPtr obj "restore" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Window::restore"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Window.html#g:signal:restore"})

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Window = WindowSignalList
type WindowSignalList = ('[ '("activate", WindowActivateSignalInfo), '("activeDescendantChanged", Atk.Object.ObjectActiveDescendantChangedSignalInfo), '("childrenChanged", Atk.Object.ObjectChildrenChangedSignalInfo), '("create", WindowCreateSignalInfo), '("deactivate", WindowDeactivateSignalInfo), '("destroy", WindowDestroySignalInfo), '("focusEvent", Atk.Object.ObjectFocusEventSignalInfo), '("maximize", WindowMaximizeSignalInfo), '("minimize", WindowMinimizeSignalInfo), '("move", WindowMoveSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("propertyChange", Atk.Object.ObjectPropertyChangeSignalInfo), '("resize", WindowResizeSignalInfo), '("restore", WindowRestoreSignalInfo), '("stateChange", Atk.Object.ObjectStateChangeSignalInfo), '("visibleDataChanged", Atk.Object.ObjectVisibleDataChangedSignalInfo)] :: [(Symbol, *)])

#endif