{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gdk.Interfaces.Toplevel.Toplevel' is a freestanding toplevel surface.
-- 
-- The t'GI.Gdk.Interfaces.Toplevel.Toplevel' interface provides useful APIs for
-- interacting with the windowing system, such as controlling
-- maximization and size of the surface, setting icons and
-- transient parents for dialogs.

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

module GI.Gdk.Interfaces.Toplevel
    ( 

-- * Exported types
    Toplevel(..)                            ,
    IsToplevel                              ,
    toToplevel                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [beep]("GI.Gdk.Objects.Surface#g:method:beep"), [beginMove]("GI.Gdk.Interfaces.Toplevel#g:method:beginMove"), [beginResize]("GI.Gdk.Interfaces.Toplevel#g:method:beginResize"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [createCairoContext]("GI.Gdk.Objects.Surface#g:method:createCairoContext"), [createGlContext]("GI.Gdk.Objects.Surface#g:method:createGlContext"), [createSimilarSurface]("GI.Gdk.Objects.Surface#g:method:createSimilarSurface"), [createVulkanContext]("GI.Gdk.Objects.Surface#g:method:createVulkanContext"), [destroy]("GI.Gdk.Objects.Surface#g:method:destroy"), [focus]("GI.Gdk.Interfaces.Toplevel#g:method:focus"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hide]("GI.Gdk.Objects.Surface#g:method:hide"), [inhibitSystemShortcuts]("GI.Gdk.Interfaces.Toplevel#g:method:inhibitSystemShortcuts"), [isDestroyed]("GI.Gdk.Objects.Surface#g:method:isDestroyed"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [lower]("GI.Gdk.Interfaces.Toplevel#g:method:lower"), [minimize]("GI.Gdk.Interfaces.Toplevel#g:method:minimize"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [present]("GI.Gdk.Interfaces.Toplevel#g:method:present"), [queueRender]("GI.Gdk.Objects.Surface#g:method:queueRender"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [requestLayout]("GI.Gdk.Objects.Surface#g:method:requestLayout"), [restoreSystemShortcuts]("GI.Gdk.Interfaces.Toplevel#g:method:restoreSystemShortcuts"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [showWindowMenu]("GI.Gdk.Interfaces.Toplevel#g:method:showWindowMenu"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [supportsEdgeConstraints]("GI.Gdk.Interfaces.Toplevel#g:method:supportsEdgeConstraints"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [translateCoordinates]("GI.Gdk.Objects.Surface#g:method:translateCoordinates"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCursor]("GI.Gdk.Objects.Surface#g:method:getCursor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDeviceCursor]("GI.Gdk.Objects.Surface#g:method:getDeviceCursor"), [getDevicePosition]("GI.Gdk.Objects.Surface#g:method:getDevicePosition"), [getDisplay]("GI.Gdk.Objects.Surface#g:method:getDisplay"), [getFrameClock]("GI.Gdk.Objects.Surface#g:method:getFrameClock"), [getHeight]("GI.Gdk.Objects.Surface#g:method:getHeight"), [getMapped]("GI.Gdk.Objects.Surface#g:method:getMapped"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getScaleFactor]("GI.Gdk.Objects.Surface#g:method:getScaleFactor"), [getState]("GI.Gdk.Interfaces.Toplevel#g:method:getState"), [getWidth]("GI.Gdk.Objects.Surface#g:method:getWidth").
-- 
-- ==== Setters
-- [setCursor]("GI.Gdk.Objects.Surface#g:method:setCursor"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDecorated]("GI.Gdk.Interfaces.Toplevel#g:method:setDecorated"), [setDeletable]("GI.Gdk.Interfaces.Toplevel#g:method:setDeletable"), [setDeviceCursor]("GI.Gdk.Objects.Surface#g:method:setDeviceCursor"), [setIconList]("GI.Gdk.Interfaces.Toplevel#g:method:setIconList"), [setInputRegion]("GI.Gdk.Objects.Surface#g:method:setInputRegion"), [setModal]("GI.Gdk.Interfaces.Toplevel#g:method:setModal"), [setOpaqueRegion]("GI.Gdk.Objects.Surface#g:method:setOpaqueRegion"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setStartupId]("GI.Gdk.Interfaces.Toplevel#g:method:setStartupId"), [setTitle]("GI.Gdk.Interfaces.Toplevel#g:method:setTitle"), [setTransientFor]("GI.Gdk.Interfaces.Toplevel#g:method:setTransientFor").

#if defined(ENABLE_OVERLOADING)
    ResolveToplevelMethod                   ,
#endif

-- ** beginMove #method:beginMove#

#if defined(ENABLE_OVERLOADING)
    ToplevelBeginMoveMethodInfo             ,
#endif
    toplevelBeginMove                       ,


-- ** beginResize #method:beginResize#

#if defined(ENABLE_OVERLOADING)
    ToplevelBeginResizeMethodInfo           ,
#endif
    toplevelBeginResize                     ,


-- ** focus #method:focus#

#if defined(ENABLE_OVERLOADING)
    ToplevelFocusMethodInfo                 ,
#endif
    toplevelFocus                           ,


-- ** getState #method:getState#

#if defined(ENABLE_OVERLOADING)
    ToplevelGetStateMethodInfo              ,
#endif
    toplevelGetState                        ,


-- ** inhibitSystemShortcuts #method:inhibitSystemShortcuts#

#if defined(ENABLE_OVERLOADING)
    ToplevelInhibitSystemShortcutsMethodInfo,
#endif
    toplevelInhibitSystemShortcuts          ,


-- ** lower #method:lower#

#if defined(ENABLE_OVERLOADING)
    ToplevelLowerMethodInfo                 ,
#endif
    toplevelLower                           ,


-- ** minimize #method:minimize#

#if defined(ENABLE_OVERLOADING)
    ToplevelMinimizeMethodInfo              ,
#endif
    toplevelMinimize                        ,


-- ** present #method:present#

#if defined(ENABLE_OVERLOADING)
    ToplevelPresentMethodInfo               ,
#endif
    toplevelPresent                         ,


-- ** restoreSystemShortcuts #method:restoreSystemShortcuts#

#if defined(ENABLE_OVERLOADING)
    ToplevelRestoreSystemShortcutsMethodInfo,
#endif
    toplevelRestoreSystemShortcuts          ,


-- ** setDecorated #method:setDecorated#

#if defined(ENABLE_OVERLOADING)
    ToplevelSetDecoratedMethodInfo          ,
#endif
    toplevelSetDecorated                    ,


-- ** setDeletable #method:setDeletable#

#if defined(ENABLE_OVERLOADING)
    ToplevelSetDeletableMethodInfo          ,
#endif
    toplevelSetDeletable                    ,


-- ** setIconList #method:setIconList#

#if defined(ENABLE_OVERLOADING)
    ToplevelSetIconListMethodInfo           ,
#endif
    toplevelSetIconList                     ,


-- ** setModal #method:setModal#

#if defined(ENABLE_OVERLOADING)
    ToplevelSetModalMethodInfo              ,
#endif
    toplevelSetModal                        ,


-- ** setStartupId #method:setStartupId#

#if defined(ENABLE_OVERLOADING)
    ToplevelSetStartupIdMethodInfo          ,
#endif
    toplevelSetStartupId                    ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    ToplevelSetTitleMethodInfo              ,
#endif
    toplevelSetTitle                        ,


-- ** setTransientFor #method:setTransientFor#

#if defined(ENABLE_OVERLOADING)
    ToplevelSetTransientForMethodInfo       ,
#endif
    toplevelSetTransientFor                 ,


-- ** showWindowMenu #method:showWindowMenu#

#if defined(ENABLE_OVERLOADING)
    ToplevelShowWindowMenuMethodInfo        ,
#endif
    toplevelShowWindowMenu                  ,


-- ** supportsEdgeConstraints #method:supportsEdgeConstraints#

#if defined(ENABLE_OVERLOADING)
    ToplevelSupportsEdgeConstraintsMethodInfo,
#endif
    toplevelSupportsEdgeConstraints         ,




 -- * Properties


-- ** decorated #attr:decorated#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ToplevelDecoratedPropertyInfo           ,
#endif
    constructToplevelDecorated              ,
    getToplevelDecorated                    ,
    setToplevelDecorated                    ,
#if defined(ENABLE_OVERLOADING)
    toplevelDecorated                       ,
#endif


-- ** deletable #attr:deletable#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ToplevelDeletablePropertyInfo           ,
#endif
    constructToplevelDeletable              ,
    getToplevelDeletable                    ,
    setToplevelDeletable                    ,
#if defined(ENABLE_OVERLOADING)
    toplevelDeletable                       ,
#endif


-- ** fullscreenMode #attr:fullscreenMode#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ToplevelFullscreenModePropertyInfo      ,
#endif
    constructToplevelFullscreenMode         ,
    getToplevelFullscreenMode               ,
    setToplevelFullscreenMode               ,
#if defined(ENABLE_OVERLOADING)
    toplevelFullscreenMode                  ,
#endif


-- ** iconList #attr:iconList#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ToplevelIconListPropertyInfo            ,
#endif
    constructToplevelIconList               ,
    getToplevelIconList                     ,
    setToplevelIconList                     ,
#if defined(ENABLE_OVERLOADING)
    toplevelIconList                        ,
#endif


-- ** modal #attr:modal#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ToplevelModalPropertyInfo               ,
#endif
    constructToplevelModal                  ,
    getToplevelModal                        ,
    setToplevelModal                        ,
#if defined(ENABLE_OVERLOADING)
    toplevelModal                           ,
#endif


-- ** shortcutsInhibited #attr:shortcutsInhibited#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ToplevelShortcutsInhibitedPropertyInfo  ,
#endif
    getToplevelShortcutsInhibited           ,
#if defined(ENABLE_OVERLOADING)
    toplevelShortcutsInhibited              ,
#endif


-- ** startupId #attr:startupId#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ToplevelStartupIdPropertyInfo           ,
#endif
    constructToplevelStartupId              ,
    getToplevelStartupId                    ,
    setToplevelStartupId                    ,
#if defined(ENABLE_OVERLOADING)
    toplevelStartupId                       ,
#endif


-- ** state #attr:state#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ToplevelStatePropertyInfo               ,
#endif
    getToplevelState                        ,
#if defined(ENABLE_OVERLOADING)
    toplevelState                           ,
#endif


-- ** title #attr:title#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ToplevelTitlePropertyInfo               ,
#endif
    constructToplevelTitle                  ,
    getToplevelTitle                        ,
    setToplevelTitle                        ,
#if defined(ENABLE_OVERLOADING)
    toplevelTitle                           ,
#endif


-- ** transientFor #attr:transientFor#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ToplevelTransientForPropertyInfo        ,
#endif
    constructToplevelTransientFor           ,
    getToplevelTransientFor                 ,
    setToplevelTransientFor                 ,
#if defined(ENABLE_OVERLOADING)
    toplevelTransientFor                    ,
#endif




 -- * Signals


-- ** computeSize #signal:computeSize#

#if defined(ENABLE_OVERLOADING)
    ToplevelComputeSizeSignalInfo           ,
#endif




    ) 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.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 qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Objects.Device as Gdk.Device
import {-# SOURCE #-} qualified GI.Gdk.Objects.Event as Gdk.Event
import {-# SOURCE #-} qualified GI.Gdk.Objects.Surface as Gdk.Surface
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture
import {-# SOURCE #-} qualified GI.Gdk.Structs.ToplevelLayout as Gdk.ToplevelLayout

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

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

foreign import ccall "gdk_toplevel_get_type"
    c_gdk_toplevel_get_type :: IO B.Types.GType

instance B.Types.TypedObject Toplevel where
    glibType :: IO GType
glibType = IO GType
c_gdk_toplevel_get_type

instance B.Types.GObject Toplevel

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

instance O.HasParentTypes Toplevel
type instance O.ParentTypes Toplevel = '[GObject.Object.Object, Gdk.Surface.Surface]

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

-- | Convert 'Toplevel' 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 Toplevel) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gdk_toplevel_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Toplevel -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Toplevel
P.Nothing = Ptr GValue -> Ptr Toplevel -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Toplevel
forall a. Ptr a
FP.nullPtr :: FP.Ptr Toplevel)
    gvalueSet_ Ptr GValue
gv (P.Just Toplevel
obj) = Toplevel -> (Ptr Toplevel -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Toplevel
obj (Ptr GValue -> Ptr Toplevel -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Toplevel)
gvalueGet_ Ptr GValue
gv = do
        Ptr Toplevel
ptr <- Ptr GValue -> IO (Ptr Toplevel)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Toplevel)
        if Ptr Toplevel
ptr Ptr Toplevel -> Ptr Toplevel -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Toplevel
forall a. Ptr a
FP.nullPtr
        then Toplevel -> Maybe Toplevel
forall a. a -> Maybe a
P.Just (Toplevel -> Maybe Toplevel) -> IO Toplevel -> IO (Maybe Toplevel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Toplevel -> Toplevel) -> Ptr Toplevel -> IO Toplevel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Toplevel -> Toplevel
Toplevel Ptr Toplevel
ptr
        else Maybe Toplevel -> IO (Maybe Toplevel)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Toplevel
forall a. Maybe a
P.Nothing
        
    

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ToplevelDecoratedPropertyInfo
instance AttrInfo ToplevelDecoratedPropertyInfo where
    type AttrAllowedOps ToplevelDecoratedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToplevelDecoratedPropertyInfo = IsToplevel
    type AttrSetTypeConstraint ToplevelDecoratedPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ToplevelDecoratedPropertyInfo = (~) Bool
    type AttrTransferType ToplevelDecoratedPropertyInfo = Bool
    type AttrGetType ToplevelDecoratedPropertyInfo = Bool
    type AttrLabel ToplevelDecoratedPropertyInfo = "decorated"
    type AttrOrigin ToplevelDecoratedPropertyInfo = Toplevel
    attrGet = getToplevelDecorated
    attrSet = setToplevelDecorated
    attrTransfer _ v = do
        return v
    attrConstruct = constructToplevelDecorated
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ToplevelDeletablePropertyInfo
instance AttrInfo ToplevelDeletablePropertyInfo where
    type AttrAllowedOps ToplevelDeletablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToplevelDeletablePropertyInfo = IsToplevel
    type AttrSetTypeConstraint ToplevelDeletablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ToplevelDeletablePropertyInfo = (~) Bool
    type AttrTransferType ToplevelDeletablePropertyInfo = Bool
    type AttrGetType ToplevelDeletablePropertyInfo = Bool
    type AttrLabel ToplevelDeletablePropertyInfo = "deletable"
    type AttrOrigin ToplevelDeletablePropertyInfo = Toplevel
    attrGet = getToplevelDeletable
    attrSet = setToplevelDeletable
    attrTransfer _ v = do
        return v
    attrConstruct = constructToplevelDeletable
    attrClear = undefined
#endif

-- VVV Prop "fullscreen-mode"
   -- Type: TInterface (Name {namespace = "Gdk", name = "FullscreenMode"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@fullscreen-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' toplevel #fullscreenMode
-- @
getToplevelFullscreenMode :: (MonadIO m, IsToplevel o) => o -> m Gdk.Enums.FullscreenMode
getToplevelFullscreenMode :: forall (m :: * -> *) o.
(MonadIO m, IsToplevel o) =>
o -> m FullscreenMode
getToplevelFullscreenMode o
obj = IO FullscreenMode -> m FullscreenMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO FullscreenMode -> m FullscreenMode)
-> IO FullscreenMode -> m FullscreenMode
forall a b. (a -> b) -> a -> b
$ o -> String -> IO FullscreenMode
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"fullscreen-mode"

-- | Set the value of the “@fullscreen-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' toplevel [ #fullscreenMode 'Data.GI.Base.Attributes.:=' value ]
-- @
setToplevelFullscreenMode :: (MonadIO m, IsToplevel o) => o -> Gdk.Enums.FullscreenMode -> m ()
setToplevelFullscreenMode :: forall (m :: * -> *) o.
(MonadIO m, IsToplevel o) =>
o -> FullscreenMode -> m ()
setToplevelFullscreenMode o
obj FullscreenMode
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> FullscreenMode -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"fullscreen-mode" FullscreenMode
val

-- | Construct a `GValueConstruct` with valid value for the “@fullscreen-mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructToplevelFullscreenMode :: (IsToplevel o, MIO.MonadIO m) => Gdk.Enums.FullscreenMode -> m (GValueConstruct o)
constructToplevelFullscreenMode :: forall o (m :: * -> *).
(IsToplevel o, MonadIO m) =>
FullscreenMode -> m (GValueConstruct o)
constructToplevelFullscreenMode FullscreenMode
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> FullscreenMode -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"fullscreen-mode" FullscreenMode
val

#if defined(ENABLE_OVERLOADING)
data ToplevelFullscreenModePropertyInfo
instance AttrInfo ToplevelFullscreenModePropertyInfo where
    type AttrAllowedOps ToplevelFullscreenModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToplevelFullscreenModePropertyInfo = IsToplevel
    type AttrSetTypeConstraint ToplevelFullscreenModePropertyInfo = (~) Gdk.Enums.FullscreenMode
    type AttrTransferTypeConstraint ToplevelFullscreenModePropertyInfo = (~) Gdk.Enums.FullscreenMode
    type AttrTransferType ToplevelFullscreenModePropertyInfo = Gdk.Enums.FullscreenMode
    type AttrGetType ToplevelFullscreenModePropertyInfo = Gdk.Enums.FullscreenMode
    type AttrLabel ToplevelFullscreenModePropertyInfo = "fullscreen-mode"
    type AttrOrigin ToplevelFullscreenModePropertyInfo = Toplevel
    attrGet = getToplevelFullscreenMode
    attrSet = setToplevelFullscreenMode
    attrTransfer _ v = do
        return v
    attrConstruct = constructToplevelFullscreenMode
    attrClear = undefined
#endif

-- VVV Prop "icon-list"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@icon-list@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructToplevelIconList :: (IsToplevel o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructToplevelIconList :: forall o (m :: * -> *).
(IsToplevel o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructToplevelIconList Ptr ()
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"icon-list" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data ToplevelIconListPropertyInfo
instance AttrInfo ToplevelIconListPropertyInfo where
    type AttrAllowedOps ToplevelIconListPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToplevelIconListPropertyInfo = IsToplevel
    type AttrSetTypeConstraint ToplevelIconListPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint ToplevelIconListPropertyInfo = (~) (Ptr ())
    type AttrTransferType ToplevelIconListPropertyInfo = Ptr ()
    type AttrGetType ToplevelIconListPropertyInfo = (Ptr ())
    type AttrLabel ToplevelIconListPropertyInfo = "icon-list"
    type AttrOrigin ToplevelIconListPropertyInfo = Toplevel
    attrGet = getToplevelIconList
    attrSet = setToplevelIconList
    attrTransfer _ v = do
        return v
    attrConstruct = constructToplevelIconList
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ToplevelModalPropertyInfo
instance AttrInfo ToplevelModalPropertyInfo where
    type AttrAllowedOps ToplevelModalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToplevelModalPropertyInfo = IsToplevel
    type AttrSetTypeConstraint ToplevelModalPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ToplevelModalPropertyInfo = (~) Bool
    type AttrTransferType ToplevelModalPropertyInfo = Bool
    type AttrGetType ToplevelModalPropertyInfo = Bool
    type AttrLabel ToplevelModalPropertyInfo = "modal"
    type AttrOrigin ToplevelModalPropertyInfo = Toplevel
    attrGet = getToplevelModal
    attrSet = setToplevelModal
    attrTransfer _ v = do
        return v
    attrConstruct = constructToplevelModal
    attrClear = undefined
#endif

-- VVV Prop "shortcuts-inhibited"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data ToplevelShortcutsInhibitedPropertyInfo
instance AttrInfo ToplevelShortcutsInhibitedPropertyInfo where
    type AttrAllowedOps ToplevelShortcutsInhibitedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ToplevelShortcutsInhibitedPropertyInfo = IsToplevel
    type AttrSetTypeConstraint ToplevelShortcutsInhibitedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ToplevelShortcutsInhibitedPropertyInfo = (~) ()
    type AttrTransferType ToplevelShortcutsInhibitedPropertyInfo = ()
    type AttrGetType ToplevelShortcutsInhibitedPropertyInfo = Bool
    type AttrLabel ToplevelShortcutsInhibitedPropertyInfo = "shortcuts-inhibited"
    type AttrOrigin ToplevelShortcutsInhibitedPropertyInfo = Toplevel
    attrGet = getToplevelShortcutsInhibited
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ToplevelStartupIdPropertyInfo
instance AttrInfo ToplevelStartupIdPropertyInfo where
    type AttrAllowedOps ToplevelStartupIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToplevelStartupIdPropertyInfo = IsToplevel
    type AttrSetTypeConstraint ToplevelStartupIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ToplevelStartupIdPropertyInfo = (~) T.Text
    type AttrTransferType ToplevelStartupIdPropertyInfo = T.Text
    type AttrGetType ToplevelStartupIdPropertyInfo = (Maybe T.Text)
    type AttrLabel ToplevelStartupIdPropertyInfo = "startup-id"
    type AttrOrigin ToplevelStartupIdPropertyInfo = Toplevel
    attrGet = getToplevelStartupId
    attrSet = setToplevelStartupId
    attrTransfer _ v = do
        return v
    attrConstruct = constructToplevelStartupId
    attrClear = undefined
#endif

-- VVV Prop "state"
   -- Type: TInterface (Name {namespace = "Gdk", name = "ToplevelState"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' toplevel #state
-- @
getToplevelState :: (MonadIO m, IsToplevel o) => o -> m [Gdk.Flags.ToplevelState]
getToplevelState :: forall (m :: * -> *) o.
(MonadIO m, IsToplevel o) =>
o -> m [ToplevelState]
getToplevelState o
obj = IO [ToplevelState] -> m [ToplevelState]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [ToplevelState] -> m [ToplevelState])
-> IO [ToplevelState] -> m [ToplevelState]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [ToplevelState]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"state"

#if defined(ENABLE_OVERLOADING)
data ToplevelStatePropertyInfo
instance AttrInfo ToplevelStatePropertyInfo where
    type AttrAllowedOps ToplevelStatePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ToplevelStatePropertyInfo = IsToplevel
    type AttrSetTypeConstraint ToplevelStatePropertyInfo = (~) ()
    type AttrTransferTypeConstraint ToplevelStatePropertyInfo = (~) ()
    type AttrTransferType ToplevelStatePropertyInfo = ()
    type AttrGetType ToplevelStatePropertyInfo = [Gdk.Flags.ToplevelState]
    type AttrLabel ToplevelStatePropertyInfo = "state"
    type AttrOrigin ToplevelStatePropertyInfo = Toplevel
    attrGet = getToplevelState
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ToplevelTitlePropertyInfo
instance AttrInfo ToplevelTitlePropertyInfo where
    type AttrAllowedOps ToplevelTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToplevelTitlePropertyInfo = IsToplevel
    type AttrSetTypeConstraint ToplevelTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ToplevelTitlePropertyInfo = (~) T.Text
    type AttrTransferType ToplevelTitlePropertyInfo = T.Text
    type AttrGetType ToplevelTitlePropertyInfo = (Maybe T.Text)
    type AttrLabel ToplevelTitlePropertyInfo = "title"
    type AttrOrigin ToplevelTitlePropertyInfo = Toplevel
    attrGet = getToplevelTitle
    attrSet = setToplevelTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructToplevelTitle
    attrClear = undefined
#endif

-- VVV Prop "transient-for"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Surface"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@transient-for@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructToplevelTransientFor :: (IsToplevel o, MIO.MonadIO m, Gdk.Surface.IsSurface a) => a -> m (GValueConstruct o)
constructToplevelTransientFor :: forall o (m :: * -> *) a.
(IsToplevel o, MonadIO m, IsSurface a) =>
a -> m (GValueConstruct o)
constructToplevelTransientFor a
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"transient-for" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data ToplevelTransientForPropertyInfo
instance AttrInfo ToplevelTransientForPropertyInfo where
    type AttrAllowedOps ToplevelTransientForPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToplevelTransientForPropertyInfo = IsToplevel
    type AttrSetTypeConstraint ToplevelTransientForPropertyInfo = Gdk.Surface.IsSurface
    type AttrTransferTypeConstraint ToplevelTransientForPropertyInfo = Gdk.Surface.IsSurface
    type AttrTransferType ToplevelTransientForPropertyInfo = Gdk.Surface.Surface
    type AttrGetType ToplevelTransientForPropertyInfo = (Maybe Gdk.Surface.Surface)
    type AttrLabel ToplevelTransientForPropertyInfo = "transient-for"
    type AttrOrigin ToplevelTransientForPropertyInfo = Toplevel
    attrGet = getToplevelTransientFor
    attrSet = setToplevelTransientFor
    attrTransfer _ v = do
        unsafeCastTo Gdk.Surface.Surface v
    attrConstruct = constructToplevelTransientFor
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Toplevel
type instance O.AttributeList Toplevel = ToplevelAttributeList
type ToplevelAttributeList = ('[ '("cursor", Gdk.Surface.SurfaceCursorPropertyInfo), '("decorated", ToplevelDecoratedPropertyInfo), '("deletable", ToplevelDeletablePropertyInfo), '("display", Gdk.Surface.SurfaceDisplayPropertyInfo), '("frameClock", Gdk.Surface.SurfaceFrameClockPropertyInfo), '("fullscreenMode", ToplevelFullscreenModePropertyInfo), '("height", Gdk.Surface.SurfaceHeightPropertyInfo), '("iconList", ToplevelIconListPropertyInfo), '("mapped", Gdk.Surface.SurfaceMappedPropertyInfo), '("modal", ToplevelModalPropertyInfo), '("scaleFactor", Gdk.Surface.SurfaceScaleFactorPropertyInfo), '("shortcutsInhibited", ToplevelShortcutsInhibitedPropertyInfo), '("startupId", ToplevelStartupIdPropertyInfo), '("state", ToplevelStatePropertyInfo), '("title", ToplevelTitlePropertyInfo), '("transientFor", ToplevelTransientForPropertyInfo), '("width", Gdk.Surface.SurfaceWidthPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
toplevelDecorated :: AttrLabelProxy "decorated"
toplevelDecorated = AttrLabelProxy

toplevelDeletable :: AttrLabelProxy "deletable"
toplevelDeletable = AttrLabelProxy

toplevelFullscreenMode :: AttrLabelProxy "fullscreenMode"
toplevelFullscreenMode = AttrLabelProxy

toplevelIconList :: AttrLabelProxy "iconList"
toplevelIconList = AttrLabelProxy

toplevelModal :: AttrLabelProxy "modal"
toplevelModal = AttrLabelProxy

toplevelShortcutsInhibited :: AttrLabelProxy "shortcutsInhibited"
toplevelShortcutsInhibited = AttrLabelProxy

toplevelStartupId :: AttrLabelProxy "startupId"
toplevelStartupId = AttrLabelProxy

toplevelState :: AttrLabelProxy "state"
toplevelState = AttrLabelProxy

toplevelTitle :: AttrLabelProxy "title"
toplevelTitle = AttrLabelProxy

toplevelTransientFor :: AttrLabelProxy "transientFor"
toplevelTransientFor = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveToplevelMethod (t :: Symbol) (o :: *) :: * where
    ResolveToplevelMethod "beep" o = Gdk.Surface.SurfaceBeepMethodInfo
    ResolveToplevelMethod "beginMove" o = ToplevelBeginMoveMethodInfo
    ResolveToplevelMethod "beginResize" o = ToplevelBeginResizeMethodInfo
    ResolveToplevelMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveToplevelMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveToplevelMethod "createCairoContext" o = Gdk.Surface.SurfaceCreateCairoContextMethodInfo
    ResolveToplevelMethod "createGlContext" o = Gdk.Surface.SurfaceCreateGlContextMethodInfo
    ResolveToplevelMethod "createSimilarSurface" o = Gdk.Surface.SurfaceCreateSimilarSurfaceMethodInfo
    ResolveToplevelMethod "createVulkanContext" o = Gdk.Surface.SurfaceCreateVulkanContextMethodInfo
    ResolveToplevelMethod "destroy" o = Gdk.Surface.SurfaceDestroyMethodInfo
    ResolveToplevelMethod "focus" o = ToplevelFocusMethodInfo
    ResolveToplevelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveToplevelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveToplevelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveToplevelMethod "hide" o = Gdk.Surface.SurfaceHideMethodInfo
    ResolveToplevelMethod "inhibitSystemShortcuts" o = ToplevelInhibitSystemShortcutsMethodInfo
    ResolveToplevelMethod "isDestroyed" o = Gdk.Surface.SurfaceIsDestroyedMethodInfo
    ResolveToplevelMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveToplevelMethod "lower" o = ToplevelLowerMethodInfo
    ResolveToplevelMethod "minimize" o = ToplevelMinimizeMethodInfo
    ResolveToplevelMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveToplevelMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveToplevelMethod "present" o = ToplevelPresentMethodInfo
    ResolveToplevelMethod "queueRender" o = Gdk.Surface.SurfaceQueueRenderMethodInfo
    ResolveToplevelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveToplevelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveToplevelMethod "requestLayout" o = Gdk.Surface.SurfaceRequestLayoutMethodInfo
    ResolveToplevelMethod "restoreSystemShortcuts" o = ToplevelRestoreSystemShortcutsMethodInfo
    ResolveToplevelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveToplevelMethod "showWindowMenu" o = ToplevelShowWindowMenuMethodInfo
    ResolveToplevelMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveToplevelMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveToplevelMethod "supportsEdgeConstraints" o = ToplevelSupportsEdgeConstraintsMethodInfo
    ResolveToplevelMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveToplevelMethod "translateCoordinates" o = Gdk.Surface.SurfaceTranslateCoordinatesMethodInfo
    ResolveToplevelMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveToplevelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveToplevelMethod "getCursor" o = Gdk.Surface.SurfaceGetCursorMethodInfo
    ResolveToplevelMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveToplevelMethod "getDeviceCursor" o = Gdk.Surface.SurfaceGetDeviceCursorMethodInfo
    ResolveToplevelMethod "getDevicePosition" o = Gdk.Surface.SurfaceGetDevicePositionMethodInfo
    ResolveToplevelMethod "getDisplay" o = Gdk.Surface.SurfaceGetDisplayMethodInfo
    ResolveToplevelMethod "getFrameClock" o = Gdk.Surface.SurfaceGetFrameClockMethodInfo
    ResolveToplevelMethod "getHeight" o = Gdk.Surface.SurfaceGetHeightMethodInfo
    ResolveToplevelMethod "getMapped" o = Gdk.Surface.SurfaceGetMappedMethodInfo
    ResolveToplevelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveToplevelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveToplevelMethod "getScaleFactor" o = Gdk.Surface.SurfaceGetScaleFactorMethodInfo
    ResolveToplevelMethod "getState" o = ToplevelGetStateMethodInfo
    ResolveToplevelMethod "getWidth" o = Gdk.Surface.SurfaceGetWidthMethodInfo
    ResolveToplevelMethod "setCursor" o = Gdk.Surface.SurfaceSetCursorMethodInfo
    ResolveToplevelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveToplevelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveToplevelMethod "setDecorated" o = ToplevelSetDecoratedMethodInfo
    ResolveToplevelMethod "setDeletable" o = ToplevelSetDeletableMethodInfo
    ResolveToplevelMethod "setDeviceCursor" o = Gdk.Surface.SurfaceSetDeviceCursorMethodInfo
    ResolveToplevelMethod "setIconList" o = ToplevelSetIconListMethodInfo
    ResolveToplevelMethod "setInputRegion" o = Gdk.Surface.SurfaceSetInputRegionMethodInfo
    ResolveToplevelMethod "setModal" o = ToplevelSetModalMethodInfo
    ResolveToplevelMethod "setOpaqueRegion" o = Gdk.Surface.SurfaceSetOpaqueRegionMethodInfo
    ResolveToplevelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveToplevelMethod "setStartupId" o = ToplevelSetStartupIdMethodInfo
    ResolveToplevelMethod "setTitle" o = ToplevelSetTitleMethodInfo
    ResolveToplevelMethod "setTransientFor" o = ToplevelSetTransientForMethodInfo
    ResolveToplevelMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method Toplevel::begin_move
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the device used for the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the button being used to drag, or 0 for a keyboard-initiated drag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "surface X coordinate of mouse click that began the drag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "surface Y coordinate of mouse click that began the drag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "timestamp of mouse click that began the drag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_begin_move" gdk_toplevel_begin_move :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    Ptr Gdk.Device.Device ->                -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    Int32 ->                                -- button : TBasicType TInt
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    Word32 ->                               -- timestamp : TBasicType TUInt32
    IO ()

-- | Begins an interactive move operation (for a toplevel surface).
-- You might use this function to implement draggable titlebars.
toplevelBeginMove ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a, Gdk.Device.IsDevice b) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> b
    -- ^ /@device@/: the device used for the operation
    -> Int32
    -- ^ /@button@/: the button being used to drag, or 0 for a keyboard-initiated drag
    -> Double
    -- ^ /@x@/: surface X coordinate of mouse click that began the drag
    -> Double
    -- ^ /@y@/: surface Y coordinate of mouse click that began the drag
    -> Word32
    -- ^ /@timestamp@/: timestamp of mouse click that began the drag
    -> m ()
toplevelBeginMove :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsToplevel a, IsDevice b) =>
a -> b -> Int32 -> Double -> Double -> Word32 -> m ()
toplevelBeginMove a
toplevel b
device Int32
button Double
x Double
y Word32
timestamp = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    Ptr Device
device' <- b -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
device
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    Ptr Toplevel
-> Ptr Device -> Int32 -> CDouble -> CDouble -> Word32 -> IO ()
gdk_toplevel_begin_move Ptr Toplevel
toplevel' Ptr Device
device' Int32
button CDouble
x' CDouble
y' Word32
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
device
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelBeginMoveMethodInfo
instance (signature ~ (b -> Int32 -> Double -> Double -> Word32 -> m ()), MonadIO m, IsToplevel a, Gdk.Device.IsDevice b) => O.OverloadedMethod ToplevelBeginMoveMethodInfo a signature where
    overloadedMethod = toplevelBeginMove

instance O.OverloadedMethodInfo ToplevelBeginMoveMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelBeginMove",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelBeginMove"
        }


#endif

-- method Toplevel::begin_resize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "edge"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "SurfaceEdge" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the edge or corner from which the drag is started"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the device used for the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the button being used to drag, or 0 for a keyboard-initiated drag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "surface X coordinate of mouse click that began the drag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "surface Y coordinate of mouse click that began the drag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "timestamp of mouse click that began the drag (use gdk_event_get_time())"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_begin_resize" gdk_toplevel_begin_resize :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    CUInt ->                                -- edge : TInterface (Name {namespace = "Gdk", name = "SurfaceEdge"})
    Ptr Gdk.Device.Device ->                -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    Int32 ->                                -- button : TBasicType TInt
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    Word32 ->                               -- timestamp : TBasicType TUInt32
    IO ()

-- | Begins an interactive resize operation (for a toplevel surface).
-- You might use this function to implement a “window resize grip.”
toplevelBeginResize ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a, Gdk.Device.IsDevice b) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> Gdk.Enums.SurfaceEdge
    -- ^ /@edge@/: the edge or corner from which the drag is started
    -> Maybe (b)
    -- ^ /@device@/: the device used for the operation
    -> Int32
    -- ^ /@button@/: the button being used to drag, or 0 for a keyboard-initiated drag
    -> Double
    -- ^ /@x@/: surface X coordinate of mouse click that began the drag
    -> Double
    -- ^ /@y@/: surface Y coordinate of mouse click that began the drag
    -> Word32
    -- ^ /@timestamp@/: timestamp of mouse click that began the drag (use 'GI.Gdk.Objects.Event.eventGetTime')
    -> m ()
toplevelBeginResize :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsToplevel a, IsDevice b) =>
a
-> SurfaceEdge
-> Maybe b
-> Int32
-> Double
-> Double
-> Word32
-> m ()
toplevelBeginResize a
toplevel SurfaceEdge
edge Maybe b
device Int32
button Double
x Double
y Word32
timestamp = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    let edge' :: CUInt
edge' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SurfaceEdge -> Int) -> SurfaceEdge -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SurfaceEdge -> Int
forall a. Enum a => a -> Int
fromEnum) SurfaceEdge
edge
    Ptr Device
maybeDevice <- case Maybe b
device of
        Maybe b
Nothing -> Ptr Device -> IO (Ptr Device)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Device
forall a. Ptr a
nullPtr
        Just b
jDevice -> do
            Ptr Device
jDevice' <- b -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jDevice
            Ptr Device -> IO (Ptr Device)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Device
jDevice'
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    Ptr Toplevel
-> CUInt
-> Ptr Device
-> Int32
-> CDouble
-> CDouble
-> Word32
-> IO ()
gdk_toplevel_begin_resize Ptr Toplevel
toplevel' CUInt
edge' Ptr Device
maybeDevice Int32
button CDouble
x' CDouble
y' Word32
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
device b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelBeginResizeMethodInfo
instance (signature ~ (Gdk.Enums.SurfaceEdge -> Maybe (b) -> Int32 -> Double -> Double -> Word32 -> m ()), MonadIO m, IsToplevel a, Gdk.Device.IsDevice b) => O.OverloadedMethod ToplevelBeginResizeMethodInfo a signature where
    overloadedMethod = toplevelBeginResize

instance O.OverloadedMethodInfo ToplevelBeginResizeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelBeginResize",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelBeginResize"
        }


#endif

-- method Toplevel::focus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "timestamp of the event triggering the surface focus"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_focus" gdk_toplevel_focus :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    Word32 ->                               -- timestamp : TBasicType TUInt32
    IO ()

-- | Sets keyboard focus to /@surface@/.
-- 
-- In most cases, @/gtk_window_present_with_time()/@ should be used
-- on a @/GtkWindow/@, rather than calling this function.
toplevelFocus ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> Word32
    -- ^ /@timestamp@/: timestamp of the event triggering the surface focus
    -> m ()
toplevelFocus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> Word32 -> m ()
toplevelFocus a
toplevel Word32
timestamp = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    Ptr Toplevel -> Word32 -> IO ()
gdk_toplevel_focus Ptr Toplevel
toplevel' Word32
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelFocusMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsToplevel a) => O.OverloadedMethod ToplevelFocusMethodInfo a signature where
    overloadedMethod = toplevelFocus

instance O.OverloadedMethodInfo ToplevelFocusMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelFocus",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelFocus"
        }


#endif

-- method Toplevel::get_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ToplevelState" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_get_state" gdk_toplevel_get_state :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    IO CUInt

-- | Gets the bitwise OR of the currently active surface state flags,
-- from the t'GI.Gdk.Flags.ToplevelState' enumeration.
toplevelGetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> m [Gdk.Flags.ToplevelState]
    -- ^ __Returns:__ surface state bitfield
toplevelGetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> m [ToplevelState]
toplevelGetState a
toplevel = IO [ToplevelState] -> m [ToplevelState]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ToplevelState] -> m [ToplevelState])
-> IO [ToplevelState] -> m [ToplevelState]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    CUInt
result <- Ptr Toplevel -> IO CUInt
gdk_toplevel_get_state Ptr Toplevel
toplevel'
    let result' :: [ToplevelState]
result' = CUInt -> [ToplevelState]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    [ToplevelState] -> IO [ToplevelState]
forall (m :: * -> *) a. Monad m => a -> m a
return [ToplevelState]
result'

#if defined(ENABLE_OVERLOADING)
data ToplevelGetStateMethodInfo
instance (signature ~ (m [Gdk.Flags.ToplevelState]), MonadIO m, IsToplevel a) => O.OverloadedMethod ToplevelGetStateMethodInfo a signature where
    overloadedMethod = toplevelGetState

instance O.OverloadedMethodInfo ToplevelGetStateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelGetState",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelGetState"
        }


#endif

-- method Toplevel::inhibit_system_shortcuts
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GdkToplevel requesting system keyboard shortcuts"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GdkEvent that is triggering the inhibit\n        request, or %NULL if none is available."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_inhibit_system_shortcuts" gdk_toplevel_inhibit_system_shortcuts :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    Ptr Gdk.Event.Event ->                  -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO ()

-- | Requests that the /@toplevel@/ inhibit the system shortcuts, asking the
-- desktop environment\/windowing system to let all keyboard events reach
-- the surface, as long as it is focused, instead of triggering system
-- actions.
-- 
-- If granted, the rerouting remains active until the default shortcuts
-- processing is restored with 'GI.Gdk.Interfaces.Toplevel.toplevelRestoreSystemShortcuts',
-- or the request is revoked by the desktop environment, windowing system
-- or the user.
-- 
-- A typical use case for this API is remote desktop or virtual machine
-- viewers which need to inhibit the default system keyboard shortcuts
-- so that the remote session or virtual host gets those instead of the
-- local environment.
-- 
-- The windowing system or desktop environment may ask the user to grant
-- or deny the request or even choose to ignore the request entirely.
-- 
-- The caller can be notified whenever the request is granted or revoked
-- by listening to the GdkToplevel[shortcutsInhibited](#g:signal:shortcutsInhibited) property.
toplevelInhibitSystemShortcuts ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a, Gdk.Event.IsEvent b) =>
    a
    -- ^ /@toplevel@/: the t'GI.Gdk.Interfaces.Toplevel.Toplevel' requesting system keyboard shortcuts
    -> Maybe (b)
    -- ^ /@event@/: the t'GI.Gdk.Objects.Event.Event' that is triggering the inhibit
    --         request, or 'P.Nothing' if none is available.
    -> m ()
toplevelInhibitSystemShortcuts :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsToplevel a, IsEvent b) =>
a -> Maybe b -> m ()
toplevelInhibitSystemShortcuts a
toplevel Maybe b
event = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    Ptr Event
maybeEvent <- case Maybe b
event of
        Maybe b
Nothing -> Ptr Event -> IO (Ptr Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Event
forall a. Ptr a
nullPtr
        Just b
jEvent -> do
            Ptr Event
jEvent' <- b -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jEvent
            Ptr Event -> IO (Ptr Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Event
jEvent'
    Ptr Toplevel -> Ptr Event -> IO ()
gdk_toplevel_inhibit_system_shortcuts Ptr Toplevel
toplevel' Ptr Event
maybeEvent
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
event b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelInhibitSystemShortcutsMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsToplevel a, Gdk.Event.IsEvent b) => O.OverloadedMethod ToplevelInhibitSystemShortcutsMethodInfo a signature where
    overloadedMethod = toplevelInhibitSystemShortcuts

instance O.OverloadedMethodInfo ToplevelInhibitSystemShortcutsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelInhibitSystemShortcuts",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelInhibitSystemShortcuts"
        }


#endif

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

foreign import ccall "gdk_toplevel_lower" gdk_toplevel_lower :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    IO CInt

-- | Asks to lower the /@toplevel@/ below other windows.
-- 
-- The windowing system may choose to ignore the request.
toplevelLower ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the surface was lowered
toplevelLower :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> m Bool
toplevelLower a
toplevel = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    CInt
result <- Ptr Toplevel -> IO CInt
gdk_toplevel_lower Ptr Toplevel
toplevel'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ToplevelLowerMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsToplevel a) => O.OverloadedMethod ToplevelLowerMethodInfo a signature where
    overloadedMethod = toplevelLower

instance O.OverloadedMethodInfo ToplevelLowerMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelLower",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelLower"
        }


#endif

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

foreign import ccall "gdk_toplevel_minimize" gdk_toplevel_minimize :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    IO CInt

-- | Asks to minimize the /@toplevel@/.
-- 
-- The windowing system may choose to ignore the request.
toplevelMinimize ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the surface was minimized
toplevelMinimize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> m Bool
toplevelMinimize a
toplevel = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    CInt
result <- Ptr Toplevel -> IO CInt
gdk_toplevel_minimize Ptr Toplevel
toplevel'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ToplevelMinimizeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsToplevel a) => O.OverloadedMethod ToplevelMinimizeMethodInfo a signature where
    overloadedMethod = toplevelMinimize

instance O.OverloadedMethodInfo ToplevelMinimizeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelMinimize",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelMinimize"
        }


#endif

-- method Toplevel::present
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkToplevel to show"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ToplevelLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkToplevelLayout object used to layout"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_present" gdk_toplevel_present :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    Ptr Gdk.ToplevelLayout.ToplevelLayout -> -- layout : TInterface (Name {namespace = "Gdk", name = "ToplevelLayout"})
    IO ()

-- | Present /@toplevel@/ after having processed the t'GI.Gdk.Structs.ToplevelLayout.ToplevelLayout' rules.
-- If the toplevel was previously not showing, it will be showed,
-- otherwise it will change layout according to /@layout@/.
-- 
-- GDK may emit the \'compute-size\' signal to let the user of this toplevel
-- compute the preferred size of the toplevel surface. See
-- [computeSize]("GI.Gdk.Interfaces.Toplevel#g:signal:computeSize") for details.
-- 
-- Presenting is asynchronous and the specified layout parameters are not
-- guaranteed to be respected.
toplevelPresent ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: the t'GI.Gdk.Interfaces.Toplevel.Toplevel' to show
    -> Gdk.ToplevelLayout.ToplevelLayout
    -- ^ /@layout@/: the t'GI.Gdk.Structs.ToplevelLayout.ToplevelLayout' object used to layout
    -> m ()
toplevelPresent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> ToplevelLayout -> m ()
toplevelPresent a
toplevel ToplevelLayout
layout = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    Ptr ToplevelLayout
layout' <- ToplevelLayout -> IO (Ptr ToplevelLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ToplevelLayout
layout
    Ptr Toplevel -> Ptr ToplevelLayout -> IO ()
gdk_toplevel_present Ptr Toplevel
toplevel' Ptr ToplevelLayout
layout'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    ToplevelLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ToplevelLayout
layout
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelPresentMethodInfo
instance (signature ~ (Gdk.ToplevelLayout.ToplevelLayout -> m ()), MonadIO m, IsToplevel a) => O.OverloadedMethod ToplevelPresentMethodInfo a signature where
    overloadedMethod = toplevelPresent

instance O.OverloadedMethodInfo ToplevelPresentMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelPresent",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelPresent"
        }


#endif

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

foreign import ccall "gdk_toplevel_restore_system_shortcuts" gdk_toplevel_restore_system_shortcuts :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    IO ()

-- | Restore default system keyboard shortcuts which were previously
-- requested to be inhibited by 'GI.Gdk.Interfaces.Toplevel.toplevelInhibitSystemShortcuts'.
toplevelRestoreSystemShortcuts ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> m ()
toplevelRestoreSystemShortcuts :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> m ()
toplevelRestoreSystemShortcuts a
toplevel = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    Ptr Toplevel -> IO ()
gdk_toplevel_restore_system_shortcuts Ptr Toplevel
toplevel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelRestoreSystemShortcutsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsToplevel a) => O.OverloadedMethod ToplevelRestoreSystemShortcutsMethodInfo a signature where
    overloadedMethod = toplevelRestoreSystemShortcuts

instance O.OverloadedMethodInfo ToplevelRestoreSystemShortcutsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelRestoreSystemShortcuts",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelRestoreSystemShortcuts"
        }


#endif

-- method Toplevel::set_decorated
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "decorated"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to request decorations"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_set_decorated" gdk_toplevel_set_decorated :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    CInt ->                                 -- decorated : TBasicType TBoolean
    IO ()

-- | Setting /@decorated@/ to 'P.False' hints the desktop environment
-- that the surface has its own, client-side decorations and
-- does not need to have window decorations added.
toplevelSetDecorated ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> Bool
    -- ^ /@decorated@/: 'P.True' to request decorations
    -> m ()
toplevelSetDecorated :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> Bool -> m ()
toplevelSetDecorated a
toplevel Bool
decorated = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    let decorated' :: CInt
decorated' = (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
decorated
    Ptr Toplevel -> CInt -> IO ()
gdk_toplevel_set_decorated Ptr Toplevel
toplevel' CInt
decorated'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelSetDecoratedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsToplevel a) => O.OverloadedMethod ToplevelSetDecoratedMethodInfo a signature where
    overloadedMethod = toplevelSetDecorated

instance O.OverloadedMethodInfo ToplevelSetDecoratedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelSetDecorated",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelSetDecorated"
        }


#endif

-- method Toplevel::set_deletable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "deletable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to request a delete button"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_set_deletable" gdk_toplevel_set_deletable :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    CInt ->                                 -- deletable : TBasicType TBoolean
    IO ()

-- | Setting /@deletable@/ to 'P.True' hints the desktop environment
-- that it should offer the user a way to close the surface.
toplevelSetDeletable ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> Bool
    -- ^ /@deletable@/: 'P.True' to request a delete button
    -> m ()
toplevelSetDeletable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> Bool -> m ()
toplevelSetDeletable a
toplevel Bool
deletable = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    let deletable' :: CInt
deletable' = (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
deletable
    Ptr Toplevel -> CInt -> IO ()
gdk_toplevel_set_deletable Ptr Toplevel
toplevel' CInt
deletable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelSetDeletableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsToplevel a) => O.OverloadedMethod ToplevelSetDeletableMethodInfo a signature where
    overloadedMethod = toplevelSetDeletable

instance O.OverloadedMethodInfo ToplevelSetDeletableMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelSetDeletable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelSetDeletable"
        }


#endif

-- method Toplevel::set_icon_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "surfaces"
--           , argType =
--               TGList (TInterface Name { namespace = "Gdk" , name = "Texture" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "\n    A list of textures to use as icon, of different sizes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_set_icon_list" gdk_toplevel_set_icon_list :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    Ptr (GList (Ptr Gdk.Texture.Texture)) -> -- surfaces : TGList (TInterface (Name {namespace = "Gdk", name = "Texture"}))
    IO ()

-- | Sets a list of icons for the surface.
-- 
-- One of these will be used to represent the surface in iconic form.
-- The icon may be shown in window lists or task bars. Which icon
-- size is shown depends on the window manager. The window manager
-- can scale the icon but setting several size icons can give better
-- image quality.
-- 
-- Note that some platforms don\'t support surface icons.
toplevelSetIconList ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a, Gdk.Texture.IsTexture b) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> [b]
    -- ^ /@surfaces@/: 
    --     A list of textures to use as icon, of different sizes
    -> m ()
toplevelSetIconList :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsToplevel a, IsTexture b) =>
a -> [b] -> m ()
toplevelSetIconList a
toplevel [b]
surfaces = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    [Ptr Texture]
surfaces' <- (b -> IO (Ptr Texture)) -> [b] -> IO [Ptr Texture]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM b -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [b]
surfaces
    Ptr (GList (Ptr Texture))
surfaces'' <- [Ptr Texture] -> IO (Ptr (GList (Ptr Texture)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr Texture]
surfaces'
    Ptr Toplevel -> Ptr (GList (Ptr Texture)) -> IO ()
gdk_toplevel_set_icon_list Ptr Toplevel
toplevel' Ptr (GList (Ptr Texture))
surfaces''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    (b -> IO ()) -> [b] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [b]
surfaces
    Ptr (GList (Ptr Texture)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Texture))
surfaces''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelSetIconListMethodInfo
instance (signature ~ ([b] -> m ()), MonadIO m, IsToplevel a, Gdk.Texture.IsTexture b) => O.OverloadedMethod ToplevelSetIconListMethodInfo a signature where
    overloadedMethod = toplevelSetIconList

instance O.OverloadedMethodInfo ToplevelSetIconListMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelSetIconList",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelSetIconList"
        }


#endif

-- method Toplevel::set_modal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A toplevel surface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modal"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if the surface is modal, %FALSE otherwise."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_set_modal" gdk_toplevel_set_modal :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    CInt ->                                 -- modal : TBasicType TBoolean
    IO ()

-- | The application can use this hint to tell the
-- window manager that a certain surface has modal
-- behaviour. The window manager can use this information
-- to handle modal surfaces in a special way.
-- 
-- You should only use this on surfaces for which you have
-- previously called 'GI.Gdk.Interfaces.Toplevel.toplevelSetTransientFor'.
toplevelSetModal ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: A toplevel surface
    -> Bool
    -- ^ /@modal@/: 'P.True' if the surface is modal, 'P.False' otherwise.
    -> m ()
toplevelSetModal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> Bool -> m ()
toplevelSetModal a
toplevel Bool
modal = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    let modal' :: CInt
modal' = (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
modal
    Ptr Toplevel -> CInt -> IO ()
gdk_toplevel_set_modal Ptr Toplevel
toplevel' CInt
modal'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelSetModalMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsToplevel a) => O.OverloadedMethod ToplevelSetModalMethodInfo a signature where
    overloadedMethod = toplevelSetModal

instance O.OverloadedMethodInfo ToplevelSetModalMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelSetModal",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelSetModal"
        }


#endif

-- method Toplevel::set_startup_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "startup_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string with startup-notification identifier"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_set_startup_id" gdk_toplevel_set_startup_id :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    CString ->                              -- startup_id : TBasicType TUTF8
    IO ()

-- | When using GTK, typically you should use @/gtk_window_set_startup_id()/@
-- instead of this low-level function.
toplevelSetStartupId ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> T.Text
    -- ^ /@startupId@/: a string with startup-notification identifier
    -> m ()
toplevelSetStartupId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> Text -> m ()
toplevelSetStartupId a
toplevel Text
startupId = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    CString
startupId' <- Text -> IO CString
textToCString Text
startupId
    Ptr Toplevel -> CString -> IO ()
gdk_toplevel_set_startup_id Ptr Toplevel
toplevel' CString
startupId'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
startupId'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo ToplevelSetStartupIdMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelSetStartupId",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelSetStartupId"
        }


#endif

-- method Toplevel::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "title of @surface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_set_title" gdk_toplevel_set_title :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

-- | Sets the title of a toplevel surface, to be displayed in the titlebar,
-- in lists of windows, etc.
toplevelSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> T.Text
    -- ^ /@title@/: title of /@surface@/
    -> m ()
toplevelSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> Text -> m ()
toplevelSetTitle a
toplevel Text
title = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr Toplevel -> CString -> IO ()
gdk_toplevel_set_title Ptr Toplevel
toplevel' CString
title'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo ToplevelSetTitleMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelSetTitle",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelSetTitle"
        }


#endif

-- method Toplevel::set_transient_for
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another toplevel #GdkSurface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_set_transient_for" gdk_toplevel_set_transient_for :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    Ptr Gdk.Surface.Surface ->              -- parent : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO ()

-- | Indicates to the window manager that /@surface@/ is a transient dialog
-- associated with the application surface /@parent@/. This allows the
-- window manager to do things like center /@surface@/ on /@parent@/ and
-- keep /@surface@/ above /@parent@/.
-- 
-- See @/gtk_window_set_transient_for()/@ if you’re using @/GtkWindow/@ or
-- @/GtkDialog/@.
toplevelSetTransientFor ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a, Gdk.Surface.IsSurface b) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> b
    -- ^ /@parent@/: another toplevel t'GI.Gdk.Objects.Surface.Surface'
    -> m ()
toplevelSetTransientFor :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsToplevel a, IsSurface b) =>
a -> b -> m ()
toplevelSetTransientFor a
toplevel b
parent = 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 Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    Ptr Surface
parent' <- b -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
parent
    Ptr Toplevel -> Ptr Surface -> IO ()
gdk_toplevel_set_transient_for Ptr Toplevel
toplevel' Ptr Surface
parent'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
parent
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToplevelSetTransientForMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsToplevel a, Gdk.Surface.IsSurface b) => O.OverloadedMethod ToplevelSetTransientForMethodInfo a signature where
    overloadedMethod = toplevelSetTransientFor

instance O.OverloadedMethodInfo ToplevelSetTransientForMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelSetTransientFor",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelSetTransientFor"
        }


#endif

-- method Toplevel::show_window_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toplevel"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Toplevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkToplevel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent to show the menu for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_show_window_menu" gdk_toplevel_show_window_menu :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    Ptr Gdk.Event.Event ->                  -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO CInt

-- | Asks the windowing system to show the window menu.
-- 
-- The window menu is the menu shown when right-clicking the titlebar
-- on traditional windows managed by the window manager. This is useful
-- for windows using client-side decorations, activating it with a
-- right-click on the window decorations.
toplevelShowWindowMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a, Gdk.Event.IsEvent b) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> b
    -- ^ /@event@/: a t'GI.Gdk.Objects.Event.Event' to show the menu for
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the window menu was shown and 'P.False' otherwise.
toplevelShowWindowMenu :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsToplevel a, IsEvent b) =>
a -> b -> m Bool
toplevelShowWindowMenu a
toplevel b
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    Ptr Event
event' <- b -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
event
    CInt
result <- Ptr Toplevel -> Ptr Event -> IO CInt
gdk_toplevel_show_window_menu Ptr Toplevel
toplevel' Ptr Event
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ToplevelShowWindowMenuMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsToplevel a, Gdk.Event.IsEvent b) => O.OverloadedMethod ToplevelShowWindowMenuMethodInfo a signature where
    overloadedMethod = toplevelShowWindowMenu

instance O.OverloadedMethodInfo ToplevelShowWindowMenuMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelShowWindowMenu",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelShowWindowMenu"
        }


#endif

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

foreign import ccall "gdk_toplevel_supports_edge_constraints" gdk_toplevel_supports_edge_constraints :: 
    Ptr Toplevel ->                         -- toplevel : TInterface (Name {namespace = "Gdk", name = "Toplevel"})
    IO CInt

-- | Returns whether the desktop environment supports
-- tiled window states.
toplevelSupportsEdgeConstraints ::
    (B.CallStack.HasCallStack, MonadIO m, IsToplevel a) =>
    a
    -- ^ /@toplevel@/: a t'GI.Gdk.Interfaces.Toplevel.Toplevel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the desktop environment supports
    --     tiled window states
toplevelSupportsEdgeConstraints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToplevel a) =>
a -> m Bool
toplevelSupportsEdgeConstraints a
toplevel = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toplevel
toplevel' <- a -> IO (Ptr Toplevel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
toplevel
    CInt
result <- Ptr Toplevel -> IO CInt
gdk_toplevel_supports_edge_constraints Ptr Toplevel
toplevel'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
toplevel
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ToplevelSupportsEdgeConstraintsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsToplevel a) => O.OverloadedMethod ToplevelSupportsEdgeConstraintsMethodInfo a signature where
    overloadedMethod = toplevelSupportsEdgeConstraints

instance O.OverloadedMethodInfo ToplevelSupportsEdgeConstraintsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Interfaces.Toplevel.toplevelSupportsEdgeConstraints",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Interfaces-Toplevel.html#v:toplevelSupportsEdgeConstraints"
        }


#endif

-- XXX Could not generate signal Toplevel::compute-size
-- Error was : 
-- Not implemented: Unexpected transfer type for "size"
#if defined(ENABLE_OVERLOADING)
data ToplevelComputeSizeSignalInfo
instance SignalInfo ToplevelComputeSizeSignalInfo where
    type HaskellCallbackType ToplevelComputeSizeSignalInfo = B.Signals.SignalCodeGenError "Toplevel::compute-size"
    connectSignal = undefined

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Toplevel = ToplevelSignalList
type ToplevelSignalList = ('[ '("computeSize", ToplevelComputeSizeSignalInfo), '("enterMonitor", Gdk.Surface.SurfaceEnterMonitorSignalInfo), '("event", Gdk.Surface.SurfaceEventSignalInfo), '("layout", Gdk.Surface.SurfaceLayoutSignalInfo), '("leaveMonitor", Gdk.Surface.SurfaceLeaveMonitorSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("render", Gdk.Surface.SurfaceRenderSignalInfo)] :: [(Symbol, *)])

#endif