{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gdk.Objects.Window
    ( 

-- * Exported types
    Window(..)                              ,
    WindowK                                 ,
    toWindow                                ,
    noWindow                                ,


 -- * Methods
-- ** windowAtPointer
    windowAtPointer                         ,


-- ** windowBeep
    windowBeep                              ,


-- ** windowBeginMoveDrag
    windowBeginMoveDrag                     ,


-- ** windowBeginMoveDragForDevice
    windowBeginMoveDragForDevice            ,


-- ** windowBeginPaintRect
    windowBeginPaintRect                    ,


-- ** windowBeginPaintRegion
    windowBeginPaintRegion                  ,


-- ** windowBeginResizeDrag
    windowBeginResizeDrag                   ,


-- ** windowBeginResizeDragForDevice
    windowBeginResizeDragForDevice          ,


-- ** windowConfigureFinished
    windowConfigureFinished                 ,


-- ** windowConstrainSize
    windowConstrainSize                     ,


-- ** windowCoordsFromParent
    windowCoordsFromParent                  ,


-- ** windowCoordsToParent
    windowCoordsToParent                    ,


-- ** windowCreateGlContext
    windowCreateGlContext                   ,


-- ** windowCreateSimilarImageSurface
    windowCreateSimilarImageSurface         ,


-- ** windowCreateSimilarSurface
    windowCreateSimilarSurface              ,


-- ** windowDeiconify
    windowDeiconify                         ,


-- ** windowDestroy
    windowDestroy                           ,


-- ** windowDestroyNotify
    windowDestroyNotify                     ,


-- ** windowEnableSynchronizedConfigure
    windowEnableSynchronizedConfigure       ,


-- ** windowEndPaint
    windowEndPaint                          ,


-- ** windowEnsureNative
    windowEnsureNative                      ,


-- ** windowFlush
    windowFlush                             ,


-- ** windowFocus
    windowFocus                             ,


-- ** windowFreezeToplevelUpdatesLibgtkOnly
    windowFreezeToplevelUpdatesLibgtkOnly   ,


-- ** windowFreezeUpdates
    windowFreezeUpdates                     ,


-- ** windowFullscreen
    windowFullscreen                        ,


-- ** windowFullscreenOnMonitor
    windowFullscreenOnMonitor               ,


-- ** windowGeometryChanged
    windowGeometryChanged                   ,


-- ** windowGetAcceptFocus
    windowGetAcceptFocus                    ,


-- ** windowGetBackgroundPattern
    windowGetBackgroundPattern              ,


-- ** windowGetChildren
    windowGetChildren                       ,


-- ** windowGetChildrenWithUserData
    windowGetChildrenWithUserData           ,


-- ** windowGetClipRegion
    windowGetClipRegion                     ,


-- ** windowGetComposited
    windowGetComposited                     ,


-- ** windowGetCursor
    windowGetCursor                         ,


-- ** windowGetDecorations
    windowGetDecorations                    ,


-- ** windowGetDeviceCursor
    windowGetDeviceCursor                   ,


-- ** windowGetDeviceEvents
    windowGetDeviceEvents                   ,


-- ** windowGetDevicePosition
    windowGetDevicePosition                 ,


-- ** windowGetDevicePositionDouble
    windowGetDevicePositionDouble           ,


-- ** windowGetDisplay
    windowGetDisplay                        ,


-- ** windowGetDragProtocol
    windowGetDragProtocol                   ,


-- ** windowGetEffectiveParent
    windowGetEffectiveParent                ,


-- ** windowGetEffectiveToplevel
    windowGetEffectiveToplevel              ,


-- ** windowGetEventCompression
    windowGetEventCompression               ,


-- ** windowGetEvents
    windowGetEvents                         ,


-- ** windowGetFocusOnMap
    windowGetFocusOnMap                     ,


-- ** windowGetFrameClock
    windowGetFrameClock                     ,


-- ** windowGetFrameExtents
    windowGetFrameExtents                   ,


-- ** windowGetFullscreenMode
    windowGetFullscreenMode                 ,


-- ** windowGetGeometry
    windowGetGeometry                       ,


-- ** windowGetGroup
    windowGetGroup                          ,


-- ** windowGetHeight
    windowGetHeight                         ,


-- ** windowGetModalHint
    windowGetModalHint                      ,


-- ** windowGetOrigin
    windowGetOrigin                         ,


-- ** windowGetParent
    windowGetParent                         ,


-- ** windowGetPassThrough
    windowGetPassThrough                    ,


-- ** windowGetPointer
    windowGetPointer                        ,


-- ** windowGetPosition
    windowGetPosition                       ,


-- ** windowGetRootCoords
    windowGetRootCoords                     ,


-- ** windowGetRootOrigin
    windowGetRootOrigin                     ,


-- ** windowGetScaleFactor
    windowGetScaleFactor                    ,


-- ** windowGetScreen
    windowGetScreen                         ,


-- ** windowGetSourceEvents
    windowGetSourceEvents                   ,


-- ** windowGetState
    windowGetState                          ,


-- ** windowGetSupportMultidevice
    windowGetSupportMultidevice             ,


-- ** windowGetToplevel
    windowGetToplevel                       ,


-- ** windowGetTypeHint
    windowGetTypeHint                       ,


-- ** windowGetUpdateArea
    windowGetUpdateArea                     ,


-- ** windowGetUserData
    windowGetUserData                       ,


-- ** windowGetVisibleRegion
    windowGetVisibleRegion                  ,


-- ** windowGetVisual
    windowGetVisual                         ,


-- ** windowGetWidth
    windowGetWidth                          ,


-- ** windowGetWindowType
    windowGetWindowType                     ,


-- ** windowHasNative
    windowHasNative                         ,


-- ** windowHide
    windowHide                              ,


-- ** windowIconify
    windowIconify                           ,


-- ** windowInputShapeCombineRegion
    windowInputShapeCombineRegion           ,


-- ** windowInvalidateMaybeRecurse
    windowInvalidateMaybeRecurse            ,


-- ** windowInvalidateRect
    windowInvalidateRect                    ,


-- ** windowInvalidateRegion
    windowInvalidateRegion                  ,


-- ** windowIsDestroyed
    windowIsDestroyed                       ,


-- ** windowIsInputOnly
    windowIsInputOnly                       ,


-- ** windowIsShaped
    windowIsShaped                          ,


-- ** windowIsViewable
    windowIsViewable                        ,


-- ** windowIsVisible
    windowIsVisible                         ,


-- ** windowLower
    windowLower                             ,


-- ** windowMarkPaintFromClip
    windowMarkPaintFromClip                 ,


-- ** windowMaximize
    windowMaximize                          ,


-- ** windowMergeChildInputShapes
    windowMergeChildInputShapes             ,


-- ** windowMergeChildShapes
    windowMergeChildShapes                  ,


-- ** windowMove
    windowMove                              ,


-- ** windowMoveRegion
    windowMoveRegion                        ,


-- ** windowMoveResize
    windowMoveResize                        ,


-- ** windowNew
    windowNew                               ,


-- ** windowPeekChildren
    windowPeekChildren                      ,


-- ** windowProcessAllUpdates
    windowProcessAllUpdates                 ,


-- ** windowProcessUpdates
    windowProcessUpdates                    ,


-- ** windowRaise
    windowRaise                             ,


-- ** windowRegisterDnd
    windowRegisterDnd                       ,


-- ** windowReparent
    windowReparent                          ,


-- ** windowResize
    windowResize                            ,


-- ** windowRestack
    windowRestack                           ,


-- ** windowScroll
    windowScroll                            ,


-- ** windowSetAcceptFocus
    windowSetAcceptFocus                    ,


-- ** windowSetBackground
    windowSetBackground                     ,


-- ** windowSetBackgroundPattern
    windowSetBackgroundPattern              ,


-- ** windowSetBackgroundRgba
    windowSetBackgroundRgba                 ,


-- ** windowSetChildInputShapes
    windowSetChildInputShapes               ,


-- ** windowSetChildShapes
    windowSetChildShapes                    ,


-- ** windowSetComposited
    windowSetComposited                     ,


-- ** windowSetCursor
    windowSetCursor                         ,


-- ** windowSetDebugUpdates
    windowSetDebugUpdates                   ,


-- ** windowSetDecorations
    windowSetDecorations                    ,


-- ** windowSetDeviceCursor
    windowSetDeviceCursor                   ,


-- ** windowSetDeviceEvents
    windowSetDeviceEvents                   ,


-- ** windowSetEventCompression
    windowSetEventCompression               ,


-- ** windowSetEvents
    windowSetEvents                         ,


-- ** windowSetFocusOnMap
    windowSetFocusOnMap                     ,


-- ** windowSetFullscreenMode
    windowSetFullscreenMode                 ,


-- ** windowSetFunctions
    windowSetFunctions                      ,


-- ** windowSetGeometryHints
    windowSetGeometryHints                  ,


-- ** windowSetGroup
    windowSetGroup                          ,


-- ** windowSetIconList
    windowSetIconList                       ,


-- ** windowSetIconName
    windowSetIconName                       ,


-- ** windowSetKeepAbove
    windowSetKeepAbove                      ,


-- ** windowSetKeepBelow
    windowSetKeepBelow                      ,


-- ** windowSetModalHint
    windowSetModalHint                      ,


-- ** windowSetOpacity
    windowSetOpacity                        ,


-- ** windowSetOpaqueRegion
    windowSetOpaqueRegion                   ,


-- ** windowSetOverrideRedirect
    windowSetOverrideRedirect               ,


-- ** windowSetPassThrough
    windowSetPassThrough                    ,


-- ** windowSetRole
    windowSetRole                           ,


-- ** windowSetShadowWidth
    windowSetShadowWidth                    ,


-- ** windowSetSkipPagerHint
    windowSetSkipPagerHint                  ,


-- ** windowSetSkipTaskbarHint
    windowSetSkipTaskbarHint                ,


-- ** windowSetSourceEvents
    windowSetSourceEvents                   ,


-- ** windowSetStartupId
    windowSetStartupId                      ,


-- ** windowSetStaticGravities
    windowSetStaticGravities                ,


-- ** windowSetSupportMultidevice
    windowSetSupportMultidevice             ,


-- ** windowSetTitle
    windowSetTitle                          ,


-- ** windowSetTransientFor
    windowSetTransientFor                   ,


-- ** windowSetTypeHint
    windowSetTypeHint                       ,


-- ** windowSetUrgencyHint
    windowSetUrgencyHint                    ,


-- ** windowSetUserData
    windowSetUserData                       ,


-- ** windowShapeCombineRegion
    windowShapeCombineRegion                ,


-- ** windowShow
    windowShow                              ,


-- ** windowShowUnraised
    windowShowUnraised                      ,


-- ** windowShowWindowMenu
    windowShowWindowMenu                    ,


-- ** windowStick
    windowStick                             ,


-- ** windowThawToplevelUpdatesLibgtkOnly
    windowThawToplevelUpdatesLibgtkOnly     ,


-- ** windowThawUpdates
    windowThawUpdates                       ,


-- ** windowUnfullscreen
    windowUnfullscreen                      ,


-- ** windowUnmaximize
    windowUnmaximize                        ,


-- ** windowUnstick
    windowUnstick                           ,


-- ** windowWithdraw
    windowWithdraw                          ,




 -- * Properties
-- ** Cursor
    WindowCursorPropertyInfo                ,
    constructWindowCursor                   ,
    getWindowCursor                         ,
    setWindowCursor                         ,




 -- * Signals
-- ** CreateSurface
    WindowCreateSurfaceCallback             ,
    WindowCreateSurfaceCallbackC            ,
    WindowCreateSurfaceSignalInfo           ,
    afterWindowCreateSurface                ,
    mkWindowCreateSurfaceCallback           ,
    noWindowCreateSurfaceCallback           ,
    onWindowCreateSurface                   ,
    windowCreateSurfaceCallbackWrapper      ,
    windowCreateSurfaceClosure              ,


-- ** FromEmbedder
    WindowFromEmbedderCallback              ,
    WindowFromEmbedderCallbackC             ,
    WindowFromEmbedderSignalInfo            ,
    afterWindowFromEmbedder                 ,
    mkWindowFromEmbedderCallback            ,
    noWindowFromEmbedderCallback            ,
    onWindowFromEmbedder                    ,
    windowFromEmbedderCallbackWrapper       ,
    windowFromEmbedderClosure               ,


-- ** PickEmbeddedChild
    WindowPickEmbeddedChildCallback         ,
    WindowPickEmbeddedChildCallbackC        ,
    WindowPickEmbeddedChildSignalInfo       ,
    afterWindowPickEmbeddedChild            ,
    mkWindowPickEmbeddedChildCallback       ,
    noWindowPickEmbeddedChildCallback       ,
    onWindowPickEmbeddedChild               ,
    windowPickEmbeddedChildCallbackWrapper  ,
    windowPickEmbeddedChildClosure          ,


-- ** ToEmbedder
    WindowToEmbedderCallback                ,
    WindowToEmbedderCallbackC               ,
    WindowToEmbedderSignalInfo              ,
    afterWindowToEmbedder                   ,
    mkWindowToEmbedderCallback              ,
    noWindowToEmbedderCallback              ,
    onWindowToEmbedder                      ,
    windowToEmbedderCallbackWrapper         ,
    windowToEmbedderClosure                 ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gdk.Types
import GI.Gdk.Callbacks
import qualified GI.GObject as GObject
import qualified GI.GdkPixbuf as GdkPixbuf
import qualified GI.Cairo as Cairo

newtype Window = Window (ForeignPtr Window)
foreign import ccall "gdk_window_get_type"
    c_gdk_window_get_type :: IO GType

type instance ParentTypes Window = WindowParentTypes
type WindowParentTypes = '[GObject.Object]

instance GObject Window where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_gdk_window_get_type
    

class GObject o => WindowK o
instance (GObject o, IsDescendantOf Window o) => WindowK o

toWindow :: WindowK o => o -> IO Window
toWindow = unsafeCastTo Window

noWindow :: Maybe Window
noWindow = Nothing

-- signal Window::create-surface
type WindowCreateSurfaceCallback =
    Int32 ->
    Int32 ->
    IO Cairo.Surface

noWindowCreateSurfaceCallback :: Maybe WindowCreateSurfaceCallback
noWindowCreateSurfaceCallback = Nothing

type WindowCreateSurfaceCallbackC =
    Ptr () ->                               -- object
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO (Ptr Cairo.Surface)

foreign import ccall "wrapper"
    mkWindowCreateSurfaceCallback :: WindowCreateSurfaceCallbackC -> IO (FunPtr WindowCreateSurfaceCallbackC)

windowCreateSurfaceClosure :: WindowCreateSurfaceCallback -> IO Closure
windowCreateSurfaceClosure cb = newCClosure =<< mkWindowCreateSurfaceCallback wrapped
    where wrapped = windowCreateSurfaceCallbackWrapper cb

windowCreateSurfaceCallbackWrapper ::
    WindowCreateSurfaceCallback ->
    Ptr () ->
    Int32 ->
    Int32 ->
    Ptr () ->
    IO (Ptr Cairo.Surface)
windowCreateSurfaceCallbackWrapper _cb _ width height _ = do
    result <- _cb  width height
    result' <- copyBoxed result
    return result'

onWindowCreateSurface :: (GObject a, MonadIO m) => a -> WindowCreateSurfaceCallback -> m SignalHandlerId
onWindowCreateSurface obj cb = liftIO $ connectWindowCreateSurface obj cb SignalConnectBefore
afterWindowCreateSurface :: (GObject a, MonadIO m) => a -> WindowCreateSurfaceCallback -> m SignalHandlerId
afterWindowCreateSurface obj cb = connectWindowCreateSurface obj cb SignalConnectAfter

connectWindowCreateSurface :: (GObject a, MonadIO m) =>
                              a -> WindowCreateSurfaceCallback -> SignalConnectMode -> m SignalHandlerId
connectWindowCreateSurface obj cb after = liftIO $ do
    cb' <- mkWindowCreateSurfaceCallback (windowCreateSurfaceCallbackWrapper cb)
    connectSignalFunPtr obj "create-surface" cb' after

-- signal Window::from-embedder
type WindowFromEmbedderCallback =
    Double ->
    Double ->
    IO (Double,Double)

noWindowFromEmbedderCallback :: Maybe WindowFromEmbedderCallback
noWindowFromEmbedderCallback = Nothing

type WindowFromEmbedderCallbackC =
    Ptr () ->                               -- object
    CDouble ->
    CDouble ->
    Ptr CDouble ->
    Ptr CDouble ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkWindowFromEmbedderCallback :: WindowFromEmbedderCallbackC -> IO (FunPtr WindowFromEmbedderCallbackC)

windowFromEmbedderClosure :: WindowFromEmbedderCallback -> IO Closure
windowFromEmbedderClosure cb = newCClosure =<< mkWindowFromEmbedderCallback wrapped
    where wrapped = windowFromEmbedderCallbackWrapper cb

windowFromEmbedderCallbackWrapper ::
    WindowFromEmbedderCallback ->
    Ptr () ->
    CDouble ->
    CDouble ->
    Ptr CDouble ->
    Ptr CDouble ->
    Ptr () ->
    IO ()
windowFromEmbedderCallbackWrapper _cb _ embedder_x embedder_y offscreen_x offscreen_y _ = do
    let embedder_x' = realToFrac embedder_x
    let embedder_y' = realToFrac embedder_y
    (outoffscreen_x, outoffscreen_y) <- _cb  embedder_x' embedder_y'
    let outoffscreen_x' = realToFrac outoffscreen_x
    poke offscreen_x outoffscreen_x'
    let outoffscreen_y' = realToFrac outoffscreen_y
    poke offscreen_y outoffscreen_y'

onWindowFromEmbedder :: (GObject a, MonadIO m) => a -> WindowFromEmbedderCallback -> m SignalHandlerId
onWindowFromEmbedder obj cb = liftIO $ connectWindowFromEmbedder obj cb SignalConnectBefore
afterWindowFromEmbedder :: (GObject a, MonadIO m) => a -> WindowFromEmbedderCallback -> m SignalHandlerId
afterWindowFromEmbedder obj cb = connectWindowFromEmbedder obj cb SignalConnectAfter

connectWindowFromEmbedder :: (GObject a, MonadIO m) =>
                             a -> WindowFromEmbedderCallback -> SignalConnectMode -> m SignalHandlerId
connectWindowFromEmbedder obj cb after = liftIO $ do
    cb' <- mkWindowFromEmbedderCallback (windowFromEmbedderCallbackWrapper cb)
    connectSignalFunPtr obj "from-embedder" cb' after

-- signal Window::pick-embedded-child
type WindowPickEmbeddedChildCallback =
    Double ->
    Double ->
    IO Window

noWindowPickEmbeddedChildCallback :: Maybe WindowPickEmbeddedChildCallback
noWindowPickEmbeddedChildCallback = Nothing

type WindowPickEmbeddedChildCallbackC =
    Ptr () ->                               -- object
    CDouble ->
    CDouble ->
    Ptr () ->                               -- user_data
    IO (Ptr Window)

foreign import ccall "wrapper"
    mkWindowPickEmbeddedChildCallback :: WindowPickEmbeddedChildCallbackC -> IO (FunPtr WindowPickEmbeddedChildCallbackC)

windowPickEmbeddedChildClosure :: WindowPickEmbeddedChildCallback -> IO Closure
windowPickEmbeddedChildClosure cb = newCClosure =<< mkWindowPickEmbeddedChildCallback wrapped
    where wrapped = windowPickEmbeddedChildCallbackWrapper cb

windowPickEmbeddedChildCallbackWrapper ::
    WindowPickEmbeddedChildCallback ->
    Ptr () ->
    CDouble ->
    CDouble ->
    Ptr () ->
    IO (Ptr Window)
windowPickEmbeddedChildCallbackWrapper _cb _ x y _ = do
    let x' = realToFrac x
    let y' = realToFrac y
    result <- _cb  x' y'
    let result' = unsafeManagedPtrCastPtr result
    return result'

onWindowPickEmbeddedChild :: (GObject a, MonadIO m) => a -> WindowPickEmbeddedChildCallback -> m SignalHandlerId
onWindowPickEmbeddedChild obj cb = liftIO $ connectWindowPickEmbeddedChild obj cb SignalConnectBefore
afterWindowPickEmbeddedChild :: (GObject a, MonadIO m) => a -> WindowPickEmbeddedChildCallback -> m SignalHandlerId
afterWindowPickEmbeddedChild obj cb = connectWindowPickEmbeddedChild obj cb SignalConnectAfter

connectWindowPickEmbeddedChild :: (GObject a, MonadIO m) =>
                                  a -> WindowPickEmbeddedChildCallback -> SignalConnectMode -> m SignalHandlerId
connectWindowPickEmbeddedChild obj cb after = liftIO $ do
    cb' <- mkWindowPickEmbeddedChildCallback (windowPickEmbeddedChildCallbackWrapper cb)
    connectSignalFunPtr obj "pick-embedded-child" cb' after

-- signal Window::to-embedder
type WindowToEmbedderCallback =
    Double ->
    Double ->
    IO (Double,Double)

noWindowToEmbedderCallback :: Maybe WindowToEmbedderCallback
noWindowToEmbedderCallback = Nothing

type WindowToEmbedderCallbackC =
    Ptr () ->                               -- object
    CDouble ->
    CDouble ->
    Ptr CDouble ->
    Ptr CDouble ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkWindowToEmbedderCallback :: WindowToEmbedderCallbackC -> IO (FunPtr WindowToEmbedderCallbackC)

windowToEmbedderClosure :: WindowToEmbedderCallback -> IO Closure
windowToEmbedderClosure cb = newCClosure =<< mkWindowToEmbedderCallback wrapped
    where wrapped = windowToEmbedderCallbackWrapper cb

windowToEmbedderCallbackWrapper ::
    WindowToEmbedderCallback ->
    Ptr () ->
    CDouble ->
    CDouble ->
    Ptr CDouble ->
    Ptr CDouble ->
    Ptr () ->
    IO ()
windowToEmbedderCallbackWrapper _cb _ offscreen_x offscreen_y embedder_x embedder_y _ = do
    let offscreen_x' = realToFrac offscreen_x
    let offscreen_y' = realToFrac offscreen_y
    (outembedder_x, outembedder_y) <- _cb  offscreen_x' offscreen_y'
    let outembedder_x' = realToFrac outembedder_x
    poke embedder_x outembedder_x'
    let outembedder_y' = realToFrac outembedder_y
    poke embedder_y outembedder_y'

onWindowToEmbedder :: (GObject a, MonadIO m) => a -> WindowToEmbedderCallback -> m SignalHandlerId
onWindowToEmbedder obj cb = liftIO $ connectWindowToEmbedder obj cb SignalConnectBefore
afterWindowToEmbedder :: (GObject a, MonadIO m) => a -> WindowToEmbedderCallback -> m SignalHandlerId
afterWindowToEmbedder obj cb = connectWindowToEmbedder obj cb SignalConnectAfter

connectWindowToEmbedder :: (GObject a, MonadIO m) =>
                           a -> WindowToEmbedderCallback -> SignalConnectMode -> m SignalHandlerId
connectWindowToEmbedder obj cb after = liftIO $ do
    cb' <- mkWindowToEmbedderCallback (windowToEmbedderCallbackWrapper cb)
    connectSignalFunPtr obj "to-embedder" cb' after

-- VVV Prop "cursor"
   -- Type: TInterface "Gdk" "Cursor"
   -- Flags: [PropertyReadable,PropertyWritable]

getWindowCursor :: (MonadIO m, WindowK o) => o -> m Cursor
getWindowCursor obj = liftIO $ getObjectPropertyObject obj "cursor" Cursor

setWindowCursor :: (MonadIO m, WindowK o, CursorK a) => o -> a -> m ()
setWindowCursor obj val = liftIO $ setObjectPropertyObject obj "cursor" val

constructWindowCursor :: (CursorK a) => a -> IO ([Char], GValue)
constructWindowCursor val = constructObjectPropertyObject "cursor" val

data WindowCursorPropertyInfo
instance AttrInfo WindowCursorPropertyInfo where
    type AttrAllowedOps WindowCursorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WindowCursorPropertyInfo = CursorK
    type AttrBaseTypeConstraint WindowCursorPropertyInfo = WindowK
    type AttrGetType WindowCursorPropertyInfo = Cursor
    type AttrLabel WindowCursorPropertyInfo = "Window::cursor"
    attrGet _ = getWindowCursor
    attrSet _ = setWindowCursor
    attrConstruct _ = constructWindowCursor

type instance AttributeList Window = WindowAttributeList
type WindowAttributeList = ('[ '("cursor", WindowCursorPropertyInfo)] :: [(Symbol, *)])

data WindowCreateSurfaceSignalInfo
instance SignalInfo WindowCreateSurfaceSignalInfo where
    type HaskellCallbackType WindowCreateSurfaceSignalInfo = WindowCreateSurfaceCallback
    connectSignal _ = connectWindowCreateSurface

data WindowFromEmbedderSignalInfo
instance SignalInfo WindowFromEmbedderSignalInfo where
    type HaskellCallbackType WindowFromEmbedderSignalInfo = WindowFromEmbedderCallback
    connectSignal _ = connectWindowFromEmbedder

data WindowPickEmbeddedChildSignalInfo
instance SignalInfo WindowPickEmbeddedChildSignalInfo where
    type HaskellCallbackType WindowPickEmbeddedChildSignalInfo = WindowPickEmbeddedChildCallback
    connectSignal _ = connectWindowPickEmbeddedChild

data WindowToEmbedderSignalInfo
instance SignalInfo WindowToEmbedderSignalInfo where
    type HaskellCallbackType WindowToEmbedderSignalInfo = WindowToEmbedderCallback
    connectSignal _ = connectWindowToEmbedder

type instance SignalList Window = WindowSignalList
type WindowSignalList = ('[ '("create-surface", WindowCreateSurfaceSignalInfo), '("from-embedder", WindowFromEmbedderSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("pick-embedded-child", WindowPickEmbeddedChildSignalInfo), '("to-embedder", WindowToEmbedderSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method Window::new
-- method type : Constructor
-- Args : [Arg {argName = "parent", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TInterface "Gdk" "WindowAttr", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes_mask", argType = TInterface "Gdk" "WindowAttributesType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "parent", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TInterface "Gdk" "WindowAttr", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes_mask", argType = TInterface "Gdk" "WindowAttributesType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_new" gdk_window_new :: 
    Ptr Window ->                           -- parent : TInterface "Gdk" "Window"
    Ptr WindowAttr ->                       -- attributes : TInterface "Gdk" "WindowAttr"
    CUInt ->                                -- attributes_mask : TInterface "Gdk" "WindowAttributesType"
    IO (Ptr Window)


windowNew ::
    (MonadIO m, WindowK a) =>
    Maybe (a) ->                            -- parent
    WindowAttr ->                           -- attributes
    [WindowAttributesType] ->               -- attributes_mask
    m Window
windowNew parent attributes attributes_mask = liftIO $ do
    maybeParent <- case parent of
        Nothing -> return nullPtr
        Just jParent -> do
            let jParent' = unsafeManagedPtrCastPtr jParent
            return jParent'
    let attributes' = unsafeManagedPtrGetPtr attributes
    let attributes_mask' = gflagsToWord attributes_mask
    result <- gdk_window_new maybeParent attributes' attributes_mask'
    checkUnexpectedReturnNULL "gdk_window_new" result
    result' <- (wrapObject Window) result
    whenJust parent touchManagedPtr
    touchManagedPtr attributes
    return result'

-- method Window::beep
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_beep" gdk_window_beep :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowBeep ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowBeep _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_beep _obj'
    touchManagedPtr _obj
    return ()

-- method Window::begin_move_drag
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timestamp", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timestamp", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_begin_move_drag" gdk_window_begin_move_drag :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Int32 ->                                -- button : TBasicType TInt32
    Int32 ->                                -- root_x : TBasicType TInt32
    Int32 ->                                -- root_y : TBasicType TInt32
    Word32 ->                               -- timestamp : TBasicType TUInt32
    IO ()


windowBeginMoveDrag ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- button
    Int32 ->                                -- root_x
    Int32 ->                                -- root_y
    Word32 ->                               -- timestamp
    m ()
windowBeginMoveDrag _obj button root_x root_y timestamp = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_begin_move_drag _obj' button root_x root_y timestamp
    touchManagedPtr _obj
    return ()

-- method Window::begin_move_drag_for_device
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timestamp", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timestamp", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_begin_move_drag_for_device" gdk_window_begin_move_drag_for_device :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Device ->                           -- device : TInterface "Gdk" "Device"
    Int32 ->                                -- button : TBasicType TInt32
    Int32 ->                                -- root_x : TBasicType TInt32
    Int32 ->                                -- root_y : TBasicType TInt32
    Word32 ->                               -- timestamp : TBasicType TUInt32
    IO ()


windowBeginMoveDragForDevice ::
    (MonadIO m, WindowK a, DeviceK b) =>
    a ->                                    -- _obj
    b ->                                    -- device
    Int32 ->                                -- button
    Int32 ->                                -- root_x
    Int32 ->                                -- root_y
    Word32 ->                               -- timestamp
    m ()
windowBeginMoveDragForDevice _obj device button root_x root_y timestamp = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let device' = unsafeManagedPtrCastPtr device
    gdk_window_begin_move_drag_for_device _obj' device' button root_x root_y timestamp
    touchManagedPtr _obj
    touchManagedPtr device
    return ()

-- method Window::begin_paint_rect
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rectangle", argType = TInterface "Gdk" "Rectangle", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rectangle", argType = TInterface "Gdk" "Rectangle", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_begin_paint_rect" gdk_window_begin_paint_rect :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Rectangle ->                        -- rectangle : TInterface "Gdk" "Rectangle"
    IO ()


windowBeginPaintRect ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Rectangle ->                            -- rectangle
    m ()
windowBeginPaintRect _obj rectangle = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let rectangle' = unsafeManagedPtrGetPtr rectangle
    gdk_window_begin_paint_rect _obj' rectangle'
    touchManagedPtr _obj
    touchManagedPtr rectangle
    return ()

-- method Window::begin_paint_region
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_begin_paint_region" gdk_window_begin_paint_region :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Cairo.Region ->                     -- region : TInterface "cairo" "Region"
    IO ()


windowBeginPaintRegion ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Cairo.Region ->                         -- region
    m ()
windowBeginPaintRegion _obj region = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let region' = unsafeManagedPtrGetPtr region
    gdk_window_begin_paint_region _obj' region'
    touchManagedPtr _obj
    touchManagedPtr region
    return ()

-- method Window::begin_resize_drag
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "edge", argType = TInterface "Gdk" "WindowEdge", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timestamp", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "edge", argType = TInterface "Gdk" "WindowEdge", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timestamp", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_begin_resize_drag" gdk_window_begin_resize_drag :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CUInt ->                                -- edge : TInterface "Gdk" "WindowEdge"
    Int32 ->                                -- button : TBasicType TInt32
    Int32 ->                                -- root_x : TBasicType TInt32
    Int32 ->                                -- root_y : TBasicType TInt32
    Word32 ->                               -- timestamp : TBasicType TUInt32
    IO ()


windowBeginResizeDrag ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    WindowEdge ->                           -- edge
    Int32 ->                                -- button
    Int32 ->                                -- root_x
    Int32 ->                                -- root_y
    Word32 ->                               -- timestamp
    m ()
windowBeginResizeDrag _obj edge button root_x root_y timestamp = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let edge' = (fromIntegral . fromEnum) edge
    gdk_window_begin_resize_drag _obj' edge' button root_x root_y timestamp
    touchManagedPtr _obj
    return ()

-- method Window::begin_resize_drag_for_device
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "edge", argType = TInterface "Gdk" "WindowEdge", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timestamp", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "edge", argType = TInterface "Gdk" "WindowEdge", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "button", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timestamp", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_begin_resize_drag_for_device" gdk_window_begin_resize_drag_for_device :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CUInt ->                                -- edge : TInterface "Gdk" "WindowEdge"
    Ptr Device ->                           -- device : TInterface "Gdk" "Device"
    Int32 ->                                -- button : TBasicType TInt32
    Int32 ->                                -- root_x : TBasicType TInt32
    Int32 ->                                -- root_y : TBasicType TInt32
    Word32 ->                               -- timestamp : TBasicType TUInt32
    IO ()


windowBeginResizeDragForDevice ::
    (MonadIO m, WindowK a, DeviceK b) =>
    a ->                                    -- _obj
    WindowEdge ->                           -- edge
    b ->                                    -- device
    Int32 ->                                -- button
    Int32 ->                                -- root_x
    Int32 ->                                -- root_y
    Word32 ->                               -- timestamp
    m ()
windowBeginResizeDragForDevice _obj edge device button root_x root_y timestamp = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let edge' = (fromIntegral . fromEnum) edge
    let device' = unsafeManagedPtrCastPtr device
    gdk_window_begin_resize_drag_for_device _obj' edge' device' button root_x root_y timestamp
    touchManagedPtr _obj
    touchManagedPtr device
    return ()

-- method Window::configure_finished
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_configure_finished" gdk_window_configure_finished :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()

{-# DEPRECATED windowConfigureFinished ["(Since version 3.8)","this function is no longer needed"]#-}
windowConfigureFinished ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowConfigureFinished _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_configure_finished _obj'
    touchManagedPtr _obj
    return ()

-- method Window::coords_from_parent
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_x", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_y", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TDouble, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TDouble, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_x", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_y", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_coords_from_parent" gdk_window_coords_from_parent :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CDouble ->                              -- parent_x : TBasicType TDouble
    CDouble ->                              -- parent_y : TBasicType TDouble
    Ptr CDouble ->                          -- x : TBasicType TDouble
    Ptr CDouble ->                          -- y : TBasicType TDouble
    IO ()


windowCoordsFromParent ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Double ->                               -- parent_x
    Double ->                               -- parent_y
    m (Double,Double)
windowCoordsFromParent _obj parent_x parent_y = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let parent_x' = realToFrac parent_x
    let parent_y' = realToFrac parent_y
    x <- allocMem :: IO (Ptr CDouble)
    y <- allocMem :: IO (Ptr CDouble)
    gdk_window_coords_from_parent _obj' parent_x' parent_y' x y
    x' <- peek x
    let x'' = realToFrac x'
    y' <- peek y
    let y'' = realToFrac y'
    touchManagedPtr _obj
    freeMem x
    freeMem y
    return (x'', y'')

-- method Window::coords_to_parent
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_x", argType = TBasicType TDouble, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "parent_y", argType = TBasicType TDouble, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_coords_to_parent" gdk_window_coords_to_parent :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    Ptr CDouble ->                          -- parent_x : TBasicType TDouble
    Ptr CDouble ->                          -- parent_y : TBasicType TDouble
    IO ()


windowCoordsToParent ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Double ->                               -- x
    Double ->                               -- y
    m (Double,Double)
windowCoordsToParent _obj x y = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let x' = realToFrac x
    let y' = realToFrac y
    parent_x <- allocMem :: IO (Ptr CDouble)
    parent_y <- allocMem :: IO (Ptr CDouble)
    gdk_window_coords_to_parent _obj' x' y' parent_x parent_y
    parent_x' <- peek parent_x
    let parent_x'' = realToFrac parent_x'
    parent_y' <- peek parent_y
    let parent_y'' = realToFrac parent_y'
    touchManagedPtr _obj
    freeMem parent_x
    freeMem parent_y
    return (parent_x'', parent_y'')

-- method Window::create_gl_context
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "GLContext"
-- throws : True
-- Skip return : False

foreign import ccall "gdk_window_create_gl_context" gdk_window_create_gl_context :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GLContext)


windowCreateGlContext ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m GLContext
windowCreateGlContext _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    onException (do
        result <- propagateGError $ gdk_window_create_gl_context _obj'
        checkUnexpectedReturnNULL "gdk_window_create_gl_context" result
        result' <- (wrapObject GLContext) result
        touchManagedPtr _obj
        return result'
     ) (do
        return ()
     )

-- method Window::create_similar_image_surface
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scale", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scale", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "cairo" "Surface"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_create_similar_image_surface" gdk_window_create_similar_image_surface :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Int32 ->                                -- format : TBasicType TInt32
    Int32 ->                                -- width : TBasicType TInt32
    Int32 ->                                -- height : TBasicType TInt32
    Int32 ->                                -- scale : TBasicType TInt32
    IO (Ptr Cairo.Surface)


windowCreateSimilarImageSurface ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- format
    Int32 ->                                -- width
    Int32 ->                                -- height
    Int32 ->                                -- scale
    m Cairo.Surface
windowCreateSimilarImageSurface _obj format width height scale = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_create_similar_image_surface _obj' format width height scale
    checkUnexpectedReturnNULL "gdk_window_create_similar_image_surface" result
    result' <- (wrapBoxed Cairo.Surface) result
    touchManagedPtr _obj
    return result'

-- method Window::create_similar_surface
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content", argType = TInterface "cairo" "Content", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content", argType = TInterface "cairo" "Content", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "cairo" "Surface"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_create_similar_surface" gdk_window_create_similar_surface :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CUInt ->                                -- content : TInterface "cairo" "Content"
    Int32 ->                                -- width : TBasicType TInt32
    Int32 ->                                -- height : TBasicType TInt32
    IO (Ptr Cairo.Surface)


windowCreateSimilarSurface ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Cairo.Content ->                        -- content
    Int32 ->                                -- width
    Int32 ->                                -- height
    m Cairo.Surface
windowCreateSimilarSurface _obj content width height = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let content' = (fromIntegral . fromEnum) content
    result <- gdk_window_create_similar_surface _obj' content' width height
    checkUnexpectedReturnNULL "gdk_window_create_similar_surface" result
    result' <- (wrapBoxed Cairo.Surface) result
    touchManagedPtr _obj
    return result'

-- method Window::deiconify
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_deiconify" gdk_window_deiconify :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowDeiconify ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowDeiconify _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_deiconify _obj'
    touchManagedPtr _obj
    return ()

-- method Window::destroy
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_destroy" gdk_window_destroy :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowDestroy ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowDestroy _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_destroy _obj'
    touchManagedPtr _obj
    return ()

-- method Window::destroy_notify
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_destroy_notify" gdk_window_destroy_notify :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowDestroyNotify ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowDestroyNotify _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_destroy_notify _obj'
    touchManagedPtr _obj
    return ()

-- method Window::enable_synchronized_configure
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_enable_synchronized_configure" gdk_window_enable_synchronized_configure :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()

{-# DEPRECATED windowEnableSynchronizedConfigure ["(Since version 3.8)","this function is no longer needed"]#-}
windowEnableSynchronizedConfigure ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowEnableSynchronizedConfigure _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_enable_synchronized_configure _obj'
    touchManagedPtr _obj
    return ()

-- method Window::end_paint
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_end_paint" gdk_window_end_paint :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowEndPaint ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowEndPaint _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_end_paint _obj'
    touchManagedPtr _obj
    return ()

-- method Window::ensure_native
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_ensure_native" gdk_window_ensure_native :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowEnsureNative ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowEnsureNative _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_ensure_native _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::flush
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_flush" gdk_window_flush :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()

{-# DEPRECATED windowFlush ["(Since version 3.14)"]#-}
windowFlush ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowFlush _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_flush _obj'
    touchManagedPtr _obj
    return ()

-- method Window::focus
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timestamp", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timestamp", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_focus" gdk_window_focus :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Word32 ->                               -- timestamp : TBasicType TUInt32
    IO ()


windowFocus ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Word32 ->                               -- timestamp
    m ()
windowFocus _obj timestamp = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_focus _obj' timestamp
    touchManagedPtr _obj
    return ()

-- method Window::freeze_toplevel_updates_libgtk_only
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_freeze_toplevel_updates_libgtk_only" gdk_window_freeze_toplevel_updates_libgtk_only :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()

{-# DEPRECATED windowFreezeToplevelUpdatesLibgtkOnly ["(Since version 3.16)","This symbol was never meant to be used outside of GTK+"]#-}
windowFreezeToplevelUpdatesLibgtkOnly ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowFreezeToplevelUpdatesLibgtkOnly _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_freeze_toplevel_updates_libgtk_only _obj'
    touchManagedPtr _obj
    return ()

-- method Window::freeze_updates
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_freeze_updates" gdk_window_freeze_updates :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowFreezeUpdates ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowFreezeUpdates _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_freeze_updates _obj'
    touchManagedPtr _obj
    return ()

-- method Window::fullscreen
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_fullscreen" gdk_window_fullscreen :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowFullscreen ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowFullscreen _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_fullscreen _obj'
    touchManagedPtr _obj
    return ()

-- method Window::fullscreen_on_monitor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_fullscreen_on_monitor" gdk_window_fullscreen_on_monitor :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Int32 ->                                -- monitor : TBasicType TInt32
    IO ()


windowFullscreenOnMonitor ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- monitor
    m ()
windowFullscreenOnMonitor _obj monitor = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_fullscreen_on_monitor _obj' monitor
    touchManagedPtr _obj
    return ()

-- method Window::geometry_changed
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_geometry_changed" gdk_window_geometry_changed :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowGeometryChanged ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowGeometryChanged _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_geometry_changed _obj'
    touchManagedPtr _obj
    return ()

-- method Window::get_accept_focus
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_accept_focus" gdk_window_get_accept_focus :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowGetAcceptFocus ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowGetAcceptFocus _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_accept_focus _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::get_background_pattern
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "cairo" "Pattern"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_background_pattern" gdk_window_get_background_pattern :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Cairo.Pattern)


windowGetBackgroundPattern ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Cairo.Pattern
windowGetBackgroundPattern _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_background_pattern _obj'
    checkUnexpectedReturnNULL "gdk_window_get_background_pattern" result
    result' <- (newBoxed Cairo.Pattern) result
    touchManagedPtr _obj
    return result'

-- method Window::get_children
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGList (TInterface "Gdk" "Window")
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_children" gdk_window_get_children :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr (GList (Ptr Window)))


windowGetChildren ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m [Window]
windowGetChildren _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_children _obj'
    checkUnexpectedReturnNULL "gdk_window_get_children" result
    result' <- unpackGList result
    result'' <- mapM (newObject Window) result'
    g_list_free result
    touchManagedPtr _obj
    return result''

-- method Window::get_children_with_user_data
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGList (TInterface "Gdk" "Window")
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_children_with_user_data" gdk_window_get_children_with_user_data :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO (Ptr (GList (Ptr Window)))


windowGetChildrenWithUserData ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Ptr () ->                               -- user_data
    m [Window]
windowGetChildrenWithUserData _obj user_data = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_children_with_user_data _obj' user_data
    checkUnexpectedReturnNULL "gdk_window_get_children_with_user_data" result
    result' <- unpackGList result
    result'' <- mapM (newObject Window) result'
    g_list_free result
    touchManagedPtr _obj
    return result''

-- method Window::get_clip_region
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "cairo" "Region"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_clip_region" gdk_window_get_clip_region :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Cairo.Region)


windowGetClipRegion ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Cairo.Region
windowGetClipRegion _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_clip_region _obj'
    checkUnexpectedReturnNULL "gdk_window_get_clip_region" result
    result' <- (wrapBoxed Cairo.Region) result
    touchManagedPtr _obj
    return result'

-- method Window::get_composited
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_composited" gdk_window_get_composited :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt

{-# DEPRECATED windowGetComposited ["(Since version 3.16)","Compositing is an outdated technology that","  only ever worked on X11."]#-}
windowGetComposited ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowGetComposited _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_composited _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::get_cursor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Cursor"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_cursor" gdk_window_get_cursor :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Cursor)


windowGetCursor ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Cursor
windowGetCursor _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_cursor _obj'
    checkUnexpectedReturnNULL "gdk_window_get_cursor" result
    result' <- (newObject Cursor) result
    touchManagedPtr _obj
    return result'

-- method Window::get_decorations
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "decorations", argType = TInterface "Gdk" "WMDecoration", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_decorations" gdk_window_get_decorations :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr CUInt ->                            -- decorations : TInterface "Gdk" "WMDecoration"
    IO CInt


windowGetDecorations ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m (Bool,[WMDecoration])
windowGetDecorations _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    decorations <- allocMem :: IO (Ptr CUInt)
    result <- gdk_window_get_decorations _obj' decorations
    let result' = (/= 0) result
    decorations' <- peek decorations
    let decorations'' = wordToGFlags decorations'
    touchManagedPtr _obj
    freeMem decorations
    return (result', decorations'')

-- method Window::get_device_cursor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Cursor"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_device_cursor" gdk_window_get_device_cursor :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Device ->                           -- device : TInterface "Gdk" "Device"
    IO (Ptr Cursor)


windowGetDeviceCursor ::
    (MonadIO m, WindowK a, DeviceK b) =>
    a ->                                    -- _obj
    b ->                                    -- device
    m Cursor
windowGetDeviceCursor _obj device = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let device' = unsafeManagedPtrCastPtr device
    result <- gdk_window_get_device_cursor _obj' device'
    checkUnexpectedReturnNULL "gdk_window_get_device_cursor" result
    result' <- (newObject Cursor) result
    touchManagedPtr _obj
    touchManagedPtr device
    return result'

-- method Window::get_device_events
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "EventMask"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_device_events" gdk_window_get_device_events :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Device ->                           -- device : TInterface "Gdk" "Device"
    IO CUInt


windowGetDeviceEvents ::
    (MonadIO m, WindowK a, DeviceK b) =>
    a ->                                    -- _obj
    b ->                                    -- device
    m [EventMask]
windowGetDeviceEvents _obj device = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let device' = unsafeManagedPtrCastPtr device
    result <- gdk_window_get_device_events _obj' device'
    let result' = wordToGFlags result
    touchManagedPtr _obj
    touchManagedPtr device
    return result'

-- method Window::get_device_position
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "mask", argType = TInterface "Gdk" "ModifierType", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_device_position" gdk_window_get_device_position :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Device ->                           -- device : TInterface "Gdk" "Device"
    Ptr Int32 ->                            -- x : TBasicType TInt32
    Ptr Int32 ->                            -- y : TBasicType TInt32
    Ptr CUInt ->                            -- mask : TInterface "Gdk" "ModifierType"
    IO (Ptr Window)


windowGetDevicePosition ::
    (MonadIO m, WindowK a, DeviceK b) =>
    a ->                                    -- _obj
    b ->                                    -- device
    m (Window,Int32,Int32,[ModifierType])
windowGetDevicePosition _obj device = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let device' = unsafeManagedPtrCastPtr device
    x <- allocMem :: IO (Ptr Int32)
    y <- allocMem :: IO (Ptr Int32)
    mask <- allocMem :: IO (Ptr CUInt)
    result <- gdk_window_get_device_position _obj' device' x y mask
    checkUnexpectedReturnNULL "gdk_window_get_device_position" result
    result' <- (newObject Window) result
    x' <- peek x
    y' <- peek y
    mask' <- peek mask
    let mask'' = wordToGFlags mask'
    touchManagedPtr _obj
    touchManagedPtr device
    freeMem x
    freeMem y
    freeMem mask
    return (result', x', y', mask'')

-- method Window::get_device_position_double
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TDouble, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TDouble, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "mask", argType = TInterface "Gdk" "ModifierType", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_device_position_double" gdk_window_get_device_position_double :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Device ->                           -- device : TInterface "Gdk" "Device"
    Ptr CDouble ->                          -- x : TBasicType TDouble
    Ptr CDouble ->                          -- y : TBasicType TDouble
    Ptr CUInt ->                            -- mask : TInterface "Gdk" "ModifierType"
    IO (Ptr Window)


windowGetDevicePositionDouble ::
    (MonadIO m, WindowK a, DeviceK b) =>
    a ->                                    -- _obj
    b ->                                    -- device
    m (Window,Double,Double,[ModifierType])
windowGetDevicePositionDouble _obj device = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let device' = unsafeManagedPtrCastPtr device
    x <- allocMem :: IO (Ptr CDouble)
    y <- allocMem :: IO (Ptr CDouble)
    mask <- allocMem :: IO (Ptr CUInt)
    result <- gdk_window_get_device_position_double _obj' device' x y mask
    checkUnexpectedReturnNULL "gdk_window_get_device_position_double" result
    result' <- (newObject Window) result
    x' <- peek x
    let x'' = realToFrac x'
    y' <- peek y
    let y'' = realToFrac y'
    mask' <- peek mask
    let mask'' = wordToGFlags mask'
    touchManagedPtr _obj
    touchManagedPtr device
    freeMem x
    freeMem y
    freeMem mask
    return (result', x'', y'', mask'')

-- method Window::get_display
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Display"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_display" gdk_window_get_display :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Display)


windowGetDisplay ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Display
windowGetDisplay _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_display _obj'
    checkUnexpectedReturnNULL "gdk_window_get_display" result
    result' <- (newObject Display) result
    touchManagedPtr _obj
    return result'

-- method Window::get_drag_protocol
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TInterface "Gdk" "Window", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "DragProtocol"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_drag_protocol" gdk_window_get_drag_protocol :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr (Ptr Window) ->                     -- target : TInterface "Gdk" "Window"
    IO CUInt


windowGetDragProtocol ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m (DragProtocol,Window)
windowGetDragProtocol _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    target <- allocMem :: IO (Ptr (Ptr Window))
    result <- gdk_window_get_drag_protocol _obj' target
    let result' = (toEnum . fromIntegral) result
    target' <- peek target
    target'' <- (wrapObject Window) target'
    touchManagedPtr _obj
    freeMem target
    return (result', target'')

-- method Window::get_effective_parent
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_effective_parent" gdk_window_get_effective_parent :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Window)


windowGetEffectiveParent ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Window
windowGetEffectiveParent _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_effective_parent _obj'
    checkUnexpectedReturnNULL "gdk_window_get_effective_parent" result
    result' <- (newObject Window) result
    touchManagedPtr _obj
    return result'

-- method Window::get_effective_toplevel
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_effective_toplevel" gdk_window_get_effective_toplevel :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Window)


windowGetEffectiveToplevel ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Window
windowGetEffectiveToplevel _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_effective_toplevel _obj'
    checkUnexpectedReturnNULL "gdk_window_get_effective_toplevel" result
    result' <- (newObject Window) result
    touchManagedPtr _obj
    return result'

-- method Window::get_event_compression
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_event_compression" gdk_window_get_event_compression :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowGetEventCompression ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowGetEventCompression _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_event_compression _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::get_events
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "EventMask"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_events" gdk_window_get_events :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CUInt


windowGetEvents ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m [EventMask]
windowGetEvents _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_events _obj'
    let result' = wordToGFlags result
    touchManagedPtr _obj
    return result'

-- method Window::get_focus_on_map
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_focus_on_map" gdk_window_get_focus_on_map :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowGetFocusOnMap ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowGetFocusOnMap _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_focus_on_map _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::get_frame_clock
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "FrameClock"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_frame_clock" gdk_window_get_frame_clock :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr FrameClock)


windowGetFrameClock ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m FrameClock
windowGetFrameClock _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_frame_clock _obj'
    checkUnexpectedReturnNULL "gdk_window_get_frame_clock" result
    result' <- (newObject FrameClock) result
    touchManagedPtr _obj
    return result'

-- method Window::get_frame_extents
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rect", argType = TInterface "Gdk" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_frame_extents" gdk_window_get_frame_extents :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Rectangle ->                        -- rect : TInterface "Gdk" "Rectangle"
    IO ()


windowGetFrameExtents ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m (Rectangle)
windowGetFrameExtents _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    rect <- callocBoxedBytes 16 :: IO (Ptr Rectangle)
    gdk_window_get_frame_extents _obj' rect
    rect' <- (wrapBoxed Rectangle) rect
    touchManagedPtr _obj
    return rect'

-- method Window::get_fullscreen_mode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "FullscreenMode"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_fullscreen_mode" gdk_window_get_fullscreen_mode :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CUInt


windowGetFullscreenMode ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m FullscreenMode
windowGetFullscreenMode _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_fullscreen_mode _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method Window::get_geometry
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_geometry" gdk_window_get_geometry :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Int32 ->                            -- x : TBasicType TInt32
    Ptr Int32 ->                            -- y : TBasicType TInt32
    Ptr Int32 ->                            -- width : TBasicType TInt32
    Ptr Int32 ->                            -- height : TBasicType TInt32
    IO ()


windowGetGeometry ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m (Int32,Int32,Int32,Int32)
windowGetGeometry _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    x <- allocMem :: IO (Ptr Int32)
    y <- allocMem :: IO (Ptr Int32)
    width <- allocMem :: IO (Ptr Int32)
    height <- allocMem :: IO (Ptr Int32)
    gdk_window_get_geometry _obj' x y width height
    x' <- peek x
    y' <- peek y
    width' <- peek width
    height' <- peek height
    touchManagedPtr _obj
    freeMem x
    freeMem y
    freeMem width
    freeMem height
    return (x', y', width', height')

-- method Window::get_group
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_group" gdk_window_get_group :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Window)


windowGetGroup ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Window
windowGetGroup _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_group _obj'
    checkUnexpectedReturnNULL "gdk_window_get_group" result
    result' <- (newObject Window) result
    touchManagedPtr _obj
    return result'

-- method Window::get_height
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_height" gdk_window_get_height :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO Int32


windowGetHeight ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Int32
windowGetHeight _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_height _obj'
    touchManagedPtr _obj
    return result

-- method Window::get_modal_hint
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_modal_hint" gdk_window_get_modal_hint :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowGetModalHint ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowGetModalHint _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_modal_hint _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::get_origin
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_origin" gdk_window_get_origin :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Int32 ->                            -- x : TBasicType TInt32
    Ptr Int32 ->                            -- y : TBasicType TInt32
    IO Int32


windowGetOrigin ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m (Int32,Int32,Int32)
windowGetOrigin _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    x <- allocMem :: IO (Ptr Int32)
    y <- allocMem :: IO (Ptr Int32)
    result <- gdk_window_get_origin _obj' x y
    x' <- peek x
    y' <- peek y
    touchManagedPtr _obj
    freeMem x
    freeMem y
    return (result, x', y')

-- method Window::get_parent
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_parent" gdk_window_get_parent :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Window)


windowGetParent ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Window
windowGetParent _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_parent _obj'
    checkUnexpectedReturnNULL "gdk_window_get_parent" result
    result' <- (newObject Window) result
    touchManagedPtr _obj
    return result'

-- method Window::get_pass_through
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_pass_through" gdk_window_get_pass_through :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowGetPassThrough ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowGetPassThrough _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_pass_through _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::get_pointer
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "mask", argType = TInterface "Gdk" "ModifierType", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_pointer" gdk_window_get_pointer :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Int32 ->                            -- x : TBasicType TInt32
    Ptr Int32 ->                            -- y : TBasicType TInt32
    Ptr CUInt ->                            -- mask : TInterface "Gdk" "ModifierType"
    IO (Ptr Window)

{-# DEPRECATED windowGetPointer ["(Since version 3.0)","Use gdk_window_get_device_position() instead."]#-}
windowGetPointer ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m (Window,Int32,Int32,[ModifierType])
windowGetPointer _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    x <- allocMem :: IO (Ptr Int32)
    y <- allocMem :: IO (Ptr Int32)
    mask <- allocMem :: IO (Ptr CUInt)
    result <- gdk_window_get_pointer _obj' x y mask
    checkUnexpectedReturnNULL "gdk_window_get_pointer" result
    result' <- (newObject Window) result
    x' <- peek x
    y' <- peek y
    mask' <- peek mask
    let mask'' = wordToGFlags mask'
    touchManagedPtr _obj
    freeMem x
    freeMem y
    freeMem mask
    return (result', x', y', mask'')

-- method Window::get_position
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_position" gdk_window_get_position :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Int32 ->                            -- x : TBasicType TInt32
    Ptr Int32 ->                            -- y : TBasicType TInt32
    IO ()


windowGetPosition ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m (Int32,Int32)
windowGetPosition _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    x <- allocMem :: IO (Ptr Int32)
    y <- allocMem :: IO (Ptr Int32)
    gdk_window_get_position _obj' x y
    x' <- peek x
    y' <- peek y
    touchManagedPtr _obj
    freeMem x
    freeMem y
    return (x', y')

-- method Window::get_root_coords
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_x", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "root_y", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_root_coords" gdk_window_get_root_coords :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Int32 ->                                -- x : TBasicType TInt32
    Int32 ->                                -- y : TBasicType TInt32
    Ptr Int32 ->                            -- root_x : TBasicType TInt32
    Ptr Int32 ->                            -- root_y : TBasicType TInt32
    IO ()


windowGetRootCoords ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- x
    Int32 ->                                -- y
    m (Int32,Int32)
windowGetRootCoords _obj x y = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    root_x <- allocMem :: IO (Ptr Int32)
    root_y <- allocMem :: IO (Ptr Int32)
    gdk_window_get_root_coords _obj' x y root_x root_y
    root_x' <- peek root_x
    root_y' <- peek root_y
    touchManagedPtr _obj
    freeMem root_x
    freeMem root_y
    return (root_x', root_y')

-- method Window::get_root_origin
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_root_origin" gdk_window_get_root_origin :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Int32 ->                            -- x : TBasicType TInt32
    Ptr Int32 ->                            -- y : TBasicType TInt32
    IO ()


windowGetRootOrigin ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m (Int32,Int32)
windowGetRootOrigin _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    x <- allocMem :: IO (Ptr Int32)
    y <- allocMem :: IO (Ptr Int32)
    gdk_window_get_root_origin _obj' x y
    x' <- peek x
    y' <- peek y
    touchManagedPtr _obj
    freeMem x
    freeMem y
    return (x', y')

-- method Window::get_scale_factor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_scale_factor" gdk_window_get_scale_factor :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO Int32


windowGetScaleFactor ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Int32
windowGetScaleFactor _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_scale_factor _obj'
    touchManagedPtr _obj
    return result

-- method Window::get_screen
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Screen"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_screen" gdk_window_get_screen :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Screen)


windowGetScreen ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Screen
windowGetScreen _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_screen _obj'
    checkUnexpectedReturnNULL "gdk_window_get_screen" result
    result' <- (newObject Screen) result
    touchManagedPtr _obj
    return result'

-- method Window::get_source_events
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source", argType = TInterface "Gdk" "InputSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source", argType = TInterface "Gdk" "InputSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "EventMask"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_source_events" gdk_window_get_source_events :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CUInt ->                                -- source : TInterface "Gdk" "InputSource"
    IO CUInt


windowGetSourceEvents ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    InputSource ->                          -- source
    m [EventMask]
windowGetSourceEvents _obj source = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let source' = (fromIntegral . fromEnum) source
    result <- gdk_window_get_source_events _obj' source'
    let result' = wordToGFlags result
    touchManagedPtr _obj
    return result'

-- method Window::get_state
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "WindowState"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_state" gdk_window_get_state :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CUInt


windowGetState ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m [WindowState]
windowGetState _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_state _obj'
    let result' = wordToGFlags result
    touchManagedPtr _obj
    return result'

-- method Window::get_support_multidevice
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_support_multidevice" gdk_window_get_support_multidevice :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowGetSupportMultidevice ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowGetSupportMultidevice _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_support_multidevice _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::get_toplevel
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_toplevel" gdk_window_get_toplevel :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Window)


windowGetToplevel ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Window
windowGetToplevel _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_toplevel _obj'
    checkUnexpectedReturnNULL "gdk_window_get_toplevel" result
    result' <- (newObject Window) result
    touchManagedPtr _obj
    return result'

-- method Window::get_type_hint
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "WindowTypeHint"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_type_hint" gdk_window_get_type_hint :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CUInt


windowGetTypeHint ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m WindowTypeHint
windowGetTypeHint _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_type_hint _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method Window::get_update_area
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "cairo" "Region"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_update_area" gdk_window_get_update_area :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Cairo.Region)


windowGetUpdateArea ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Cairo.Region
windowGetUpdateArea _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_update_area _obj'
    checkUnexpectedReturnNULL "gdk_window_get_update_area" result
    result' <- (wrapBoxed Cairo.Region) result
    touchManagedPtr _obj
    return result'

-- method Window::get_user_data
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_user_data" gdk_window_get_user_data :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr (Ptr ()) ->                         -- data : TBasicType TVoid
    IO ()


windowGetUserData ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ((Ptr ()))
windowGetUserData _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    data_ <- allocMem :: IO (Ptr (Ptr ()))
    gdk_window_get_user_data _obj' data_
    data_' <- peek data_
    touchManagedPtr _obj
    freeMem data_
    return data_'

-- method Window::get_visible_region
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "cairo" "Region"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_visible_region" gdk_window_get_visible_region :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Cairo.Region)


windowGetVisibleRegion ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Cairo.Region
windowGetVisibleRegion _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_visible_region _obj'
    checkUnexpectedReturnNULL "gdk_window_get_visible_region" result
    result' <- (wrapBoxed Cairo.Region) result
    touchManagedPtr _obj
    return result'

-- method Window::get_visual
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Visual"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_visual" gdk_window_get_visual :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr Visual)


windowGetVisual ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Visual
windowGetVisual _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_visual _obj'
    checkUnexpectedReturnNULL "gdk_window_get_visual" result
    result' <- (newObject Visual) result
    touchManagedPtr _obj
    return result'

-- method Window::get_width
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_width" gdk_window_get_width :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO Int32


windowGetWidth ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Int32
windowGetWidth _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_width _obj'
    touchManagedPtr _obj
    return result

-- method Window::get_window_type
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "WindowType"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_get_window_type" gdk_window_get_window_type :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CUInt


windowGetWindowType ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m WindowType
windowGetWindowType _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_get_window_type _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method Window::has_native
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_has_native" gdk_window_has_native :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowHasNative ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowHasNative _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_has_native _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::hide
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_hide" gdk_window_hide :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowHide ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowHide _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_hide _obj'
    touchManagedPtr _obj
    return ()

-- method Window::iconify
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_iconify" gdk_window_iconify :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowIconify ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowIconify _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_iconify _obj'
    touchManagedPtr _obj
    return ()

-- method Window::input_shape_combine_region
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "shape_region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "shape_region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_input_shape_combine_region" gdk_window_input_shape_combine_region :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Cairo.Region ->                     -- shape_region : TInterface "cairo" "Region"
    Int32 ->                                -- offset_x : TBasicType TInt32
    Int32 ->                                -- offset_y : TBasicType TInt32
    IO ()


windowInputShapeCombineRegion ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Cairo.Region ->                         -- shape_region
    Int32 ->                                -- offset_x
    Int32 ->                                -- offset_y
    m ()
windowInputShapeCombineRegion _obj shape_region offset_x offset_y = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let shape_region' = unsafeManagedPtrGetPtr shape_region
    gdk_window_input_shape_combine_region _obj' shape_region' offset_x offset_y
    touchManagedPtr _obj
    touchManagedPtr shape_region
    return ()

-- method Window::invalidate_maybe_recurse
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_func", argType = TInterface "Gdk" "WindowChildFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 3, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_func", argType = TInterface "Gdk" "WindowChildFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 3, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_invalidate_maybe_recurse" gdk_window_invalidate_maybe_recurse :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Cairo.Region ->                     -- region : TInterface "cairo" "Region"
    FunPtr WindowChildFuncC ->              -- child_func : TInterface "Gdk" "WindowChildFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


windowInvalidateMaybeRecurse ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Cairo.Region ->                         -- region
    Maybe (WindowChildFunc) ->              -- child_func
    m ()
windowInvalidateMaybeRecurse _obj region child_func = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let region' = unsafeManagedPtrGetPtr region
    maybeChild_func <- case child_func of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jChild_func -> do
            jChild_func' <- mkWindowChildFunc (windowChildFuncWrapper Nothing jChild_func)
            return jChild_func'
    let user_data = nullPtr
    gdk_window_invalidate_maybe_recurse _obj' region' maybeChild_func user_data
    safeFreeFunPtr $ castFunPtrToPtr maybeChild_func
    touchManagedPtr _obj
    touchManagedPtr region
    return ()

-- method Window::invalidate_rect
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rect", argType = TInterface "Gdk" "Rectangle", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invalidate_children", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rect", argType = TInterface "Gdk" "Rectangle", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invalidate_children", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_invalidate_rect" gdk_window_invalidate_rect :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Rectangle ->                        -- rect : TInterface "Gdk" "Rectangle"
    CInt ->                                 -- invalidate_children : TBasicType TBoolean
    IO ()


windowInvalidateRect ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Maybe (Rectangle) ->                    -- rect
    Bool ->                                 -- invalidate_children
    m ()
windowInvalidateRect _obj rect invalidate_children = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeRect <- case rect of
        Nothing -> return nullPtr
        Just jRect -> do
            let jRect' = unsafeManagedPtrGetPtr jRect
            return jRect'
    let invalidate_children' = (fromIntegral . fromEnum) invalidate_children
    gdk_window_invalidate_rect _obj' maybeRect invalidate_children'
    touchManagedPtr _obj
    whenJust rect touchManagedPtr
    return ()

-- method Window::invalidate_region
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invalidate_children", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invalidate_children", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_invalidate_region" gdk_window_invalidate_region :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Cairo.Region ->                     -- region : TInterface "cairo" "Region"
    CInt ->                                 -- invalidate_children : TBasicType TBoolean
    IO ()


windowInvalidateRegion ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Cairo.Region ->                         -- region
    Bool ->                                 -- invalidate_children
    m ()
windowInvalidateRegion _obj region invalidate_children = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let region' = unsafeManagedPtrGetPtr region
    let invalidate_children' = (fromIntegral . fromEnum) invalidate_children
    gdk_window_invalidate_region _obj' region' invalidate_children'
    touchManagedPtr _obj
    touchManagedPtr region
    return ()

-- method Window::is_destroyed
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_is_destroyed" gdk_window_is_destroyed :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowIsDestroyed ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowIsDestroyed _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_is_destroyed _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::is_input_only
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_is_input_only" gdk_window_is_input_only :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowIsInputOnly ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowIsInputOnly _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_is_input_only _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::is_shaped
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_is_shaped" gdk_window_is_shaped :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowIsShaped ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowIsShaped _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_is_shaped _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::is_viewable
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_is_viewable" gdk_window_is_viewable :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowIsViewable ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowIsViewable _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_is_viewable _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::is_visible
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_is_visible" gdk_window_is_visible :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO CInt


windowIsVisible ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m Bool
windowIsVisible _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_is_visible _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::lower
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_lower" gdk_window_lower :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowLower ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowLower _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_lower _obj'
    touchManagedPtr _obj
    return ()

-- method Window::mark_paint_from_clip
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cr", argType = TInterface "cairo" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cr", argType = TInterface "cairo" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_mark_paint_from_clip" gdk_window_mark_paint_from_clip :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Cairo.Context ->                    -- cr : TInterface "cairo" "Context"
    IO ()


windowMarkPaintFromClip ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Cairo.Context ->                        -- cr
    m ()
windowMarkPaintFromClip _obj cr = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let cr' = unsafeManagedPtrGetPtr cr
    gdk_window_mark_paint_from_clip _obj' cr'
    touchManagedPtr _obj
    touchManagedPtr cr
    return ()

-- method Window::maximize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_maximize" gdk_window_maximize :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowMaximize ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowMaximize _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_maximize _obj'
    touchManagedPtr _obj
    return ()

-- method Window::merge_child_input_shapes
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_merge_child_input_shapes" gdk_window_merge_child_input_shapes :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowMergeChildInputShapes ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowMergeChildInputShapes _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_merge_child_input_shapes _obj'
    touchManagedPtr _obj
    return ()

-- method Window::merge_child_shapes
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_merge_child_shapes" gdk_window_merge_child_shapes :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowMergeChildShapes ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowMergeChildShapes _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_merge_child_shapes _obj'
    touchManagedPtr _obj
    return ()

-- method Window::move
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_move" gdk_window_move :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Int32 ->                                -- x : TBasicType TInt32
    Int32 ->                                -- y : TBasicType TInt32
    IO ()


windowMove ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- x
    Int32 ->                                -- y
    m ()
windowMove _obj x y = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_move _obj' x y
    touchManagedPtr _obj
    return ()

-- method Window::move_region
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dx", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dy", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dx", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dy", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_move_region" gdk_window_move_region :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Cairo.Region ->                     -- region : TInterface "cairo" "Region"
    Int32 ->                                -- dx : TBasicType TInt32
    Int32 ->                                -- dy : TBasicType TInt32
    IO ()


windowMoveRegion ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Cairo.Region ->                         -- region
    Int32 ->                                -- dx
    Int32 ->                                -- dy
    m ()
windowMoveRegion _obj region dx dy = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let region' = unsafeManagedPtrGetPtr region
    gdk_window_move_region _obj' region' dx dy
    touchManagedPtr _obj
    touchManagedPtr region
    return ()

-- method Window::move_resize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_move_resize" gdk_window_move_resize :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Int32 ->                                -- x : TBasicType TInt32
    Int32 ->                                -- y : TBasicType TInt32
    Int32 ->                                -- width : TBasicType TInt32
    Int32 ->                                -- height : TBasicType TInt32
    IO ()


windowMoveResize ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- x
    Int32 ->                                -- y
    Int32 ->                                -- width
    Int32 ->                                -- height
    m ()
windowMoveResize _obj x y width height = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_move_resize _obj' x y width height
    touchManagedPtr _obj
    return ()

-- method Window::peek_children
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGList (TInterface "Gdk" "Window")
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_peek_children" gdk_window_peek_children :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO (Ptr (GList (Ptr Window)))


windowPeekChildren ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m [Window]
windowPeekChildren _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_window_peek_children _obj'
    checkUnexpectedReturnNULL "gdk_window_peek_children" result
    result' <- unpackGList result
    result'' <- mapM (newObject Window) result'
    touchManagedPtr _obj
    return result''

-- method Window::process_updates
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "update_children", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "update_children", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_process_updates" gdk_window_process_updates :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- update_children : TBasicType TBoolean
    IO ()


windowProcessUpdates ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- update_children
    m ()
windowProcessUpdates _obj update_children = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let update_children' = (fromIntegral . fromEnum) update_children
    gdk_window_process_updates _obj' update_children'
    touchManagedPtr _obj
    return ()

-- method Window::raise
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_raise" gdk_window_raise :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowRaise ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowRaise _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_raise _obj'
    touchManagedPtr _obj
    return ()

-- method Window::register_dnd
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_register_dnd" gdk_window_register_dnd :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowRegisterDnd ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowRegisterDnd _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_register_dnd _obj'
    touchManagedPtr _obj
    return ()

-- method Window::reparent
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_parent", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_parent", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_reparent" gdk_window_reparent :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Window ->                           -- new_parent : TInterface "Gdk" "Window"
    Int32 ->                                -- x : TBasicType TInt32
    Int32 ->                                -- y : TBasicType TInt32
    IO ()


windowReparent ::
    (MonadIO m, WindowK a, WindowK b) =>
    a ->                                    -- _obj
    b ->                                    -- new_parent
    Int32 ->                                -- x
    Int32 ->                                -- y
    m ()
windowReparent _obj new_parent x y = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let new_parent' = unsafeManagedPtrCastPtr new_parent
    gdk_window_reparent _obj' new_parent' x y
    touchManagedPtr _obj
    touchManagedPtr new_parent
    return ()

-- method Window::resize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_resize" gdk_window_resize :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Int32 ->                                -- width : TBasicType TInt32
    Int32 ->                                -- height : TBasicType TInt32
    IO ()


windowResize ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- width
    Int32 ->                                -- height
    m ()
windowResize _obj width height = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_resize _obj' width height
    touchManagedPtr _obj
    return ()

-- method Window::restack
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sibling", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "above", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sibling", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "above", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_restack" gdk_window_restack :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Window ->                           -- sibling : TInterface "Gdk" "Window"
    CInt ->                                 -- above : TBasicType TBoolean
    IO ()


windowRestack ::
    (MonadIO m, WindowK a, WindowK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- sibling
    Bool ->                                 -- above
    m ()
windowRestack _obj sibling above = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeSibling <- case sibling of
        Nothing -> return nullPtr
        Just jSibling -> do
            let jSibling' = unsafeManagedPtrCastPtr jSibling
            return jSibling'
    let above' = (fromIntegral . fromEnum) above
    gdk_window_restack _obj' maybeSibling above'
    touchManagedPtr _obj
    whenJust sibling touchManagedPtr
    return ()

-- method Window::scroll
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dx", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dy", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dx", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dy", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_scroll" gdk_window_scroll :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Int32 ->                                -- dx : TBasicType TInt32
    Int32 ->                                -- dy : TBasicType TInt32
    IO ()


windowScroll ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- dx
    Int32 ->                                -- dy
    m ()
windowScroll _obj dx dy = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_scroll _obj' dx dy
    touchManagedPtr _obj
    return ()

-- method Window::set_accept_focus
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accept_focus", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accept_focus", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_accept_focus" gdk_window_set_accept_focus :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- accept_focus : TBasicType TBoolean
    IO ()


windowSetAcceptFocus ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- accept_focus
    m ()
windowSetAcceptFocus _obj accept_focus = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let accept_focus' = (fromIntegral . fromEnum) accept_focus
    gdk_window_set_accept_focus _obj' accept_focus'
    touchManagedPtr _obj
    return ()

-- method Window::set_background
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "color", argType = TInterface "Gdk" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "color", argType = TInterface "Gdk" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_background" gdk_window_set_background :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Color ->                            -- color : TInterface "Gdk" "Color"
    IO ()

{-# DEPRECATED windowSetBackground ["(Since version 3.4)","Use gdk_window_set_background_rgba() instead."]#-}
windowSetBackground ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Color ->                                -- color
    m ()
windowSetBackground _obj color = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let color' = unsafeManagedPtrGetPtr color
    gdk_window_set_background _obj' color'
    touchManagedPtr _obj
    touchManagedPtr color
    return ()

-- method Window::set_background_pattern
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pattern", argType = TInterface "cairo" "Pattern", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pattern", argType = TInterface "cairo" "Pattern", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_background_pattern" gdk_window_set_background_pattern :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Cairo.Pattern ->                    -- pattern : TInterface "cairo" "Pattern"
    IO ()


windowSetBackgroundPattern ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Maybe (Cairo.Pattern) ->                -- pattern
    m ()
windowSetBackgroundPattern _obj pattern = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybePattern <- case pattern of
        Nothing -> return nullPtr
        Just jPattern -> do
            let jPattern' = unsafeManagedPtrGetPtr jPattern
            return jPattern'
    gdk_window_set_background_pattern _obj' maybePattern
    touchManagedPtr _obj
    whenJust pattern touchManagedPtr
    return ()

-- method Window::set_background_rgba
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rgba", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rgba", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_background_rgba" gdk_window_set_background_rgba :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr RGBA ->                             -- rgba : TInterface "Gdk" "RGBA"
    IO ()


windowSetBackgroundRgba ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    RGBA ->                                 -- rgba
    m ()
windowSetBackgroundRgba _obj rgba = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let rgba' = unsafeManagedPtrGetPtr rgba
    gdk_window_set_background_rgba _obj' rgba'
    touchManagedPtr _obj
    touchManagedPtr rgba
    return ()

-- method Window::set_child_input_shapes
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_child_input_shapes" gdk_window_set_child_input_shapes :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowSetChildInputShapes ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowSetChildInputShapes _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_set_child_input_shapes _obj'
    touchManagedPtr _obj
    return ()

-- method Window::set_child_shapes
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_child_shapes" gdk_window_set_child_shapes :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowSetChildShapes ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowSetChildShapes _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_set_child_shapes _obj'
    touchManagedPtr _obj
    return ()

-- method Window::set_composited
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "composited", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "composited", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_composited" gdk_window_set_composited :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- composited : TBasicType TBoolean
    IO ()

{-# DEPRECATED windowSetComposited ["(Since version 3.16)","Compositing is an outdated technology that","  only ever worked on X11."]#-}
windowSetComposited ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- composited
    m ()
windowSetComposited _obj composited = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let composited' = (fromIntegral . fromEnum) composited
    gdk_window_set_composited _obj' composited'
    touchManagedPtr _obj
    return ()

-- method Window::set_cursor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cursor", argType = TInterface "Gdk" "Cursor", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cursor", argType = TInterface "Gdk" "Cursor", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_cursor" gdk_window_set_cursor :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Cursor ->                           -- cursor : TInterface "Gdk" "Cursor"
    IO ()


windowSetCursor ::
    (MonadIO m, WindowK a, CursorK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- cursor
    m ()
windowSetCursor _obj cursor = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeCursor <- case cursor of
        Nothing -> return nullPtr
        Just jCursor -> do
            let jCursor' = unsafeManagedPtrCastPtr jCursor
            return jCursor'
    gdk_window_set_cursor _obj' maybeCursor
    touchManagedPtr _obj
    whenJust cursor touchManagedPtr
    return ()

-- method Window::set_decorations
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "decorations", argType = TInterface "Gdk" "WMDecoration", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "decorations", argType = TInterface "Gdk" "WMDecoration", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_decorations" gdk_window_set_decorations :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CUInt ->                                -- decorations : TInterface "Gdk" "WMDecoration"
    IO ()


windowSetDecorations ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    [WMDecoration] ->                       -- decorations
    m ()
windowSetDecorations _obj decorations = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let decorations' = gflagsToWord decorations
    gdk_window_set_decorations _obj' decorations'
    touchManagedPtr _obj
    return ()

-- method Window::set_device_cursor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cursor", argType = TInterface "Gdk" "Cursor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cursor", argType = TInterface "Gdk" "Cursor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_device_cursor" gdk_window_set_device_cursor :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Device ->                           -- device : TInterface "Gdk" "Device"
    Ptr Cursor ->                           -- cursor : TInterface "Gdk" "Cursor"
    IO ()


windowSetDeviceCursor ::
    (MonadIO m, WindowK a, DeviceK b, CursorK c) =>
    a ->                                    -- _obj
    b ->                                    -- device
    c ->                                    -- cursor
    m ()
windowSetDeviceCursor _obj device cursor = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let device' = unsafeManagedPtrCastPtr device
    let cursor' = unsafeManagedPtrCastPtr cursor
    gdk_window_set_device_cursor _obj' device' cursor'
    touchManagedPtr _obj
    touchManagedPtr device
    touchManagedPtr cursor
    return ()

-- method Window::set_device_events
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_mask", argType = TInterface "Gdk" "EventMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "device", argType = TInterface "Gdk" "Device", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_mask", argType = TInterface "Gdk" "EventMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_device_events" gdk_window_set_device_events :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Device ->                           -- device : TInterface "Gdk" "Device"
    CUInt ->                                -- event_mask : TInterface "Gdk" "EventMask"
    IO ()


windowSetDeviceEvents ::
    (MonadIO m, WindowK a, DeviceK b) =>
    a ->                                    -- _obj
    b ->                                    -- device
    [EventMask] ->                          -- event_mask
    m ()
windowSetDeviceEvents _obj device event_mask = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let device' = unsafeManagedPtrCastPtr device
    let event_mask' = gflagsToWord event_mask
    gdk_window_set_device_events _obj' device' event_mask'
    touchManagedPtr _obj
    touchManagedPtr device
    return ()

-- method Window::set_event_compression
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_compression", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_compression", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_event_compression" gdk_window_set_event_compression :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- event_compression : TBasicType TBoolean
    IO ()


windowSetEventCompression ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- event_compression
    m ()
windowSetEventCompression _obj event_compression = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let event_compression' = (fromIntegral . fromEnum) event_compression
    gdk_window_set_event_compression _obj' event_compression'
    touchManagedPtr _obj
    return ()

-- method Window::set_events
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_mask", argType = TInterface "Gdk" "EventMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_mask", argType = TInterface "Gdk" "EventMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_events" gdk_window_set_events :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CUInt ->                                -- event_mask : TInterface "Gdk" "EventMask"
    IO ()


windowSetEvents ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    [EventMask] ->                          -- event_mask
    m ()
windowSetEvents _obj event_mask = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let event_mask' = gflagsToWord event_mask
    gdk_window_set_events _obj' event_mask'
    touchManagedPtr _obj
    return ()

-- method Window::set_focus_on_map
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "focus_on_map", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "focus_on_map", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_focus_on_map" gdk_window_set_focus_on_map :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- focus_on_map : TBasicType TBoolean
    IO ()


windowSetFocusOnMap ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- focus_on_map
    m ()
windowSetFocusOnMap _obj focus_on_map = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let focus_on_map' = (fromIntegral . fromEnum) focus_on_map
    gdk_window_set_focus_on_map _obj' focus_on_map'
    touchManagedPtr _obj
    return ()

-- method Window::set_fullscreen_mode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "Gdk" "FullscreenMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "Gdk" "FullscreenMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_fullscreen_mode" gdk_window_set_fullscreen_mode :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CUInt ->                                -- mode : TInterface "Gdk" "FullscreenMode"
    IO ()


windowSetFullscreenMode ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    FullscreenMode ->                       -- mode
    m ()
windowSetFullscreenMode _obj mode = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let mode' = (fromIntegral . fromEnum) mode
    gdk_window_set_fullscreen_mode _obj' mode'
    touchManagedPtr _obj
    return ()

-- method Window::set_functions
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "functions", argType = TInterface "Gdk" "WMFunction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "functions", argType = TInterface "Gdk" "WMFunction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_functions" gdk_window_set_functions :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CUInt ->                                -- functions : TInterface "Gdk" "WMFunction"
    IO ()


windowSetFunctions ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    [WMFunction] ->                         -- functions
    m ()
windowSetFunctions _obj functions = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let functions' = gflagsToWord functions
    gdk_window_set_functions _obj' functions'
    touchManagedPtr _obj
    return ()

-- method Window::set_geometry_hints
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "geometry", argType = TInterface "Gdk" "Geometry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "geom_mask", argType = TInterface "Gdk" "WindowHints", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "geometry", argType = TInterface "Gdk" "Geometry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "geom_mask", argType = TInterface "Gdk" "WindowHints", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_geometry_hints" gdk_window_set_geometry_hints :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Geometry ->                         -- geometry : TInterface "Gdk" "Geometry"
    CUInt ->                                -- geom_mask : TInterface "Gdk" "WindowHints"
    IO ()


windowSetGeometryHints ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Geometry ->                             -- geometry
    [WindowHints] ->                        -- geom_mask
    m ()
windowSetGeometryHints _obj geometry geom_mask = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let geometry' = unsafeManagedPtrGetPtr geometry
    let geom_mask' = gflagsToWord geom_mask
    gdk_window_set_geometry_hints _obj' geometry' geom_mask'
    touchManagedPtr _obj
    touchManagedPtr geometry
    return ()

-- method Window::set_group
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "leader", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "leader", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_group" gdk_window_set_group :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Window ->                           -- leader : TInterface "Gdk" "Window"
    IO ()


windowSetGroup ::
    (MonadIO m, WindowK a, WindowK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- leader
    m ()
windowSetGroup _obj leader = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeLeader <- case leader of
        Nothing -> return nullPtr
        Just jLeader -> do
            let jLeader' = unsafeManagedPtrCastPtr jLeader
            return jLeader'
    gdk_window_set_group _obj' maybeLeader
    touchManagedPtr _obj
    whenJust leader touchManagedPtr
    return ()

-- method Window::set_icon_list
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pixbufs", argType = TGList (TInterface "GdkPixbuf" "Pixbuf"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pixbufs", argType = TGList (TInterface "GdkPixbuf" "Pixbuf"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_icon_list" gdk_window_set_icon_list :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr (GList (Ptr GdkPixbuf.Pixbuf)) ->   -- pixbufs : TGList (TInterface "GdkPixbuf" "Pixbuf")
    IO ()


windowSetIconList ::
    (MonadIO m, WindowK a, GdkPixbuf.PixbufK b) =>
    a ->                                    -- _obj
    [b] ->                                  -- pixbufs
    m ()
windowSetIconList _obj pixbufs = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let pixbufs' = map unsafeManagedPtrCastPtr pixbufs
    pixbufs'' <- packGList pixbufs'
    gdk_window_set_icon_list _obj' pixbufs''
    touchManagedPtr _obj
    mapM_ touchManagedPtr pixbufs
    g_list_free pixbufs''
    return ()

-- method Window::set_icon_name
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_icon_name" gdk_window_set_icon_name :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CString ->                              -- name : TBasicType TUTF8
    IO ()


windowSetIconName ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Maybe (T.Text) ->                       -- name
    m ()
windowSetIconName _obj name = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeName <- case name of
        Nothing -> return nullPtr
        Just jName -> do
            jName' <- textToCString jName
            return jName'
    gdk_window_set_icon_name _obj' maybeName
    touchManagedPtr _obj
    freeMem maybeName
    return ()

-- method Window::set_keep_above
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_keep_above" gdk_window_set_keep_above :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()


windowSetKeepAbove ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- setting
    m ()
windowSetKeepAbove _obj setting = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let setting' = (fromIntegral . fromEnum) setting
    gdk_window_set_keep_above _obj' setting'
    touchManagedPtr _obj
    return ()

-- method Window::set_keep_below
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_keep_below" gdk_window_set_keep_below :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()


windowSetKeepBelow ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- setting
    m ()
windowSetKeepBelow _obj setting = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let setting' = (fromIntegral . fromEnum) setting
    gdk_window_set_keep_below _obj' setting'
    touchManagedPtr _obj
    return ()

-- method Window::set_modal_hint
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "modal", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "modal", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_modal_hint" gdk_window_set_modal_hint :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- modal : TBasicType TBoolean
    IO ()


windowSetModalHint ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- modal
    m ()
windowSetModalHint _obj modal = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let modal' = (fromIntegral . fromEnum) modal
    gdk_window_set_modal_hint _obj' modal'
    touchManagedPtr _obj
    return ()

-- method Window::set_opacity
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "opacity", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "opacity", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_opacity" gdk_window_set_opacity :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CDouble ->                              -- opacity : TBasicType TDouble
    IO ()


windowSetOpacity ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Double ->                               -- opacity
    m ()
windowSetOpacity _obj opacity = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let opacity' = realToFrac opacity
    gdk_window_set_opacity _obj' opacity'
    touchManagedPtr _obj
    return ()

-- method Window::set_opaque_region
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_opaque_region" gdk_window_set_opaque_region :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Cairo.Region ->                     -- region : TInterface "cairo" "Region"
    IO ()


windowSetOpaqueRegion ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Maybe (Cairo.Region) ->                 -- region
    m ()
windowSetOpaqueRegion _obj region = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeRegion <- case region of
        Nothing -> return nullPtr
        Just jRegion -> do
            let jRegion' = unsafeManagedPtrGetPtr jRegion
            return jRegion'
    gdk_window_set_opaque_region _obj' maybeRegion
    touchManagedPtr _obj
    whenJust region touchManagedPtr
    return ()

-- method Window::set_override_redirect
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "override_redirect", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "override_redirect", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_override_redirect" gdk_window_set_override_redirect :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- override_redirect : TBasicType TBoolean
    IO ()


windowSetOverrideRedirect ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- override_redirect
    m ()
windowSetOverrideRedirect _obj override_redirect = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let override_redirect' = (fromIntegral . fromEnum) override_redirect
    gdk_window_set_override_redirect _obj' override_redirect'
    touchManagedPtr _obj
    return ()

-- method Window::set_pass_through
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pass_through", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pass_through", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_pass_through" gdk_window_set_pass_through :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- pass_through : TBasicType TBoolean
    IO ()


windowSetPassThrough ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- pass_through
    m ()
windowSetPassThrough _obj pass_through = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let pass_through' = (fromIntegral . fromEnum) pass_through
    gdk_window_set_pass_through _obj' pass_through'
    touchManagedPtr _obj
    return ()

-- method Window::set_role
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "role", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "role", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_role" gdk_window_set_role :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CString ->                              -- role : TBasicType TUTF8
    IO ()


windowSetRole ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- role
    m ()
windowSetRole _obj role = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    role' <- textToCString role
    gdk_window_set_role _obj' role'
    touchManagedPtr _obj
    freeMem role'
    return ()

-- method Window::set_shadow_width
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "left", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "right", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "top", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bottom", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "left", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "right", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "top", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bottom", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_shadow_width" gdk_window_set_shadow_width :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Int32 ->                                -- left : TBasicType TInt32
    Int32 ->                                -- right : TBasicType TInt32
    Int32 ->                                -- top : TBasicType TInt32
    Int32 ->                                -- bottom : TBasicType TInt32
    IO ()


windowSetShadowWidth ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- left
    Int32 ->                                -- right
    Int32 ->                                -- top
    Int32 ->                                -- bottom
    m ()
windowSetShadowWidth _obj left right top bottom = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_set_shadow_width _obj' left right top bottom
    touchManagedPtr _obj
    return ()

-- method Window::set_skip_pager_hint
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "skips_pager", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "skips_pager", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_skip_pager_hint" gdk_window_set_skip_pager_hint :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- skips_pager : TBasicType TBoolean
    IO ()


windowSetSkipPagerHint ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- skips_pager
    m ()
windowSetSkipPagerHint _obj skips_pager = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let skips_pager' = (fromIntegral . fromEnum) skips_pager
    gdk_window_set_skip_pager_hint _obj' skips_pager'
    touchManagedPtr _obj
    return ()

-- method Window::set_skip_taskbar_hint
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "skips_taskbar", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "skips_taskbar", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_skip_taskbar_hint" gdk_window_set_skip_taskbar_hint :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- skips_taskbar : TBasicType TBoolean
    IO ()


windowSetSkipTaskbarHint ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- skips_taskbar
    m ()
windowSetSkipTaskbarHint _obj skips_taskbar = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let skips_taskbar' = (fromIntegral . fromEnum) skips_taskbar
    gdk_window_set_skip_taskbar_hint _obj' skips_taskbar'
    touchManagedPtr _obj
    return ()

-- method Window::set_source_events
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source", argType = TInterface "Gdk" "InputSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_mask", argType = TInterface "Gdk" "EventMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source", argType = TInterface "Gdk" "InputSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_mask", argType = TInterface "Gdk" "EventMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_source_events" gdk_window_set_source_events :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CUInt ->                                -- source : TInterface "Gdk" "InputSource"
    CUInt ->                                -- event_mask : TInterface "Gdk" "EventMask"
    IO ()


windowSetSourceEvents ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    InputSource ->                          -- source
    [EventMask] ->                          -- event_mask
    m ()
windowSetSourceEvents _obj source event_mask = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let source' = (fromIntegral . fromEnum) source
    let event_mask' = gflagsToWord event_mask
    gdk_window_set_source_events _obj' source' event_mask'
    touchManagedPtr _obj
    return ()

-- method Window::set_startup_id
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "startup_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "startup_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_startup_id" gdk_window_set_startup_id :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CString ->                              -- startup_id : TBasicType TUTF8
    IO ()


windowSetStartupId ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- startup_id
    m ()
windowSetStartupId _obj startup_id = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    startup_id' <- textToCString startup_id
    gdk_window_set_startup_id _obj' startup_id'
    touchManagedPtr _obj
    freeMem startup_id'
    return ()

-- method Window::set_static_gravities
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_static", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_static", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_static_gravities" gdk_window_set_static_gravities :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- use_static : TBasicType TBoolean
    IO CInt

{-# DEPRECATED windowSetStaticGravities ["(Since version 3.16)","static gravities haven't worked on anything but X11","  for a long time."]#-}
windowSetStaticGravities ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- use_static
    m Bool
windowSetStaticGravities _obj use_static = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let use_static' = (fromIntegral . fromEnum) use_static
    result <- gdk_window_set_static_gravities _obj' use_static'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Window::set_support_multidevice
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "support_multidevice", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "support_multidevice", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_support_multidevice" gdk_window_set_support_multidevice :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- support_multidevice : TBasicType TBoolean
    IO ()


windowSetSupportMultidevice ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- support_multidevice
    m ()
windowSetSupportMultidevice _obj support_multidevice = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let support_multidevice' = (fromIntegral . fromEnum) support_multidevice
    gdk_window_set_support_multidevice _obj' support_multidevice'
    touchManagedPtr _obj
    return ()

-- method Window::set_title
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "title", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "title", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_title" gdk_window_set_title :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CString ->                              -- title : TBasicType TUTF8
    IO ()


windowSetTitle ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- title
    m ()
windowSetTitle _obj title = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    title' <- textToCString title
    gdk_window_set_title _obj' title'
    touchManagedPtr _obj
    freeMem title'
    return ()

-- method Window::set_transient_for
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_transient_for" gdk_window_set_transient_for :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Window ->                           -- parent : TInterface "Gdk" "Window"
    IO ()


windowSetTransientFor ::
    (MonadIO m, WindowK a, WindowK b) =>
    a ->                                    -- _obj
    b ->                                    -- parent
    m ()
windowSetTransientFor _obj parent = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let parent' = unsafeManagedPtrCastPtr parent
    gdk_window_set_transient_for _obj' parent'
    touchManagedPtr _obj
    touchManagedPtr parent
    return ()

-- method Window::set_type_hint
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TInterface "Gdk" "WindowTypeHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TInterface "Gdk" "WindowTypeHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_type_hint" gdk_window_set_type_hint :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CUInt ->                                -- hint : TInterface "Gdk" "WindowTypeHint"
    IO ()


windowSetTypeHint ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    WindowTypeHint ->                       -- hint
    m ()
windowSetTypeHint _obj hint = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let hint' = (fromIntegral . fromEnum) hint
    gdk_window_set_type_hint _obj' hint'
    touchManagedPtr _obj
    return ()

-- method Window::set_urgency_hint
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "urgent", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "urgent", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_urgency_hint" gdk_window_set_urgency_hint :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    CInt ->                                 -- urgent : TBasicType TBoolean
    IO ()


windowSetUrgencyHint ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- urgent
    m ()
windowSetUrgencyHint _obj urgent = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let urgent' = (fromIntegral . fromEnum) urgent
    gdk_window_set_urgency_hint _obj' urgent'
    touchManagedPtr _obj
    return ()

-- method Window::set_user_data
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_user_data" gdk_window_set_user_data :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr GObject.Object ->                   -- user_data : TInterface "GObject" "Object"
    IO ()


windowSetUserData ::
    (MonadIO m, WindowK a, GObject.ObjectK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- user_data
    m ()
windowSetUserData _obj user_data = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeUser_data <- case user_data of
        Nothing -> return nullPtr
        Just jUser_data -> do
            let jUser_data' = unsafeManagedPtrCastPtr jUser_data
            return jUser_data'
    gdk_window_set_user_data _obj' maybeUser_data
    touchManagedPtr _obj
    whenJust user_data touchManagedPtr
    return ()

-- method Window::shape_combine_region
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "shape_region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "shape_region", argType = TInterface "cairo" "Region", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset_x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset_y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_shape_combine_region" gdk_window_shape_combine_region :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Cairo.Region ->                     -- shape_region : TInterface "cairo" "Region"
    Int32 ->                                -- offset_x : TBasicType TInt32
    Int32 ->                                -- offset_y : TBasicType TInt32
    IO ()


windowShapeCombineRegion ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Maybe (Cairo.Region) ->                 -- shape_region
    Int32 ->                                -- offset_x
    Int32 ->                                -- offset_y
    m ()
windowShapeCombineRegion _obj shape_region offset_x offset_y = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeShape_region <- case shape_region of
        Nothing -> return nullPtr
        Just jShape_region -> do
            let jShape_region' = unsafeManagedPtrGetPtr jShape_region
            return jShape_region'
    gdk_window_shape_combine_region _obj' maybeShape_region offset_x offset_y
    touchManagedPtr _obj
    whenJust shape_region touchManagedPtr
    return ()

-- method Window::show
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_show" gdk_window_show :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowShow ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowShow _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_show _obj'
    touchManagedPtr _obj
    return ()

-- method Window::show_unraised
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_show_unraised" gdk_window_show_unraised :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowShowUnraised ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowShowUnraised _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_show_unraised _obj'
    touchManagedPtr _obj
    return ()

-- method Window::show_window_menu
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event", argType = TInterface "Gdk" "Event", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event", argType = TInterface "Gdk" "Event", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_show_window_menu" gdk_window_show_window_menu :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    Ptr Event ->                            -- event : TInterface "Gdk" "Event"
    IO CInt


windowShowWindowMenu ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    Event ->                                -- event
    m Bool
windowShowWindowMenu _obj event = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let event' = unsafeManagedPtrGetPtr event
    result <- gdk_window_show_window_menu _obj' event'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr event
    return result'

-- method Window::stick
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_stick" gdk_window_stick :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowStick ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowStick _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_stick _obj'
    touchManagedPtr _obj
    return ()

-- method Window::thaw_toplevel_updates_libgtk_only
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_thaw_toplevel_updates_libgtk_only" gdk_window_thaw_toplevel_updates_libgtk_only :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()

{-# DEPRECATED windowThawToplevelUpdatesLibgtkOnly ["(Since version 3.16)","This symbol was never meant to be used outside of GTK+"]#-}
windowThawToplevelUpdatesLibgtkOnly ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowThawToplevelUpdatesLibgtkOnly _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_thaw_toplevel_updates_libgtk_only _obj'
    touchManagedPtr _obj
    return ()

-- method Window::thaw_updates
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_thaw_updates" gdk_window_thaw_updates :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowThawUpdates ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowThawUpdates _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_thaw_updates _obj'
    touchManagedPtr _obj
    return ()

-- method Window::unfullscreen
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_unfullscreen" gdk_window_unfullscreen :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowUnfullscreen ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowUnfullscreen _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_unfullscreen _obj'
    touchManagedPtr _obj
    return ()

-- method Window::unmaximize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_unmaximize" gdk_window_unmaximize :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowUnmaximize ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowUnmaximize _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_unmaximize _obj'
    touchManagedPtr _obj
    return ()

-- method Window::unstick
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_unstick" gdk_window_unstick :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowUnstick ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowUnstick _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_unstick _obj'
    touchManagedPtr _obj
    return ()

-- method Window::withdraw
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_withdraw" gdk_window_withdraw :: 
    Ptr Window ->                           -- _obj : TInterface "Gdk" "Window"
    IO ()


windowWithdraw ::
    (MonadIO m, WindowK a) =>
    a ->                                    -- _obj
    m ()
windowWithdraw _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gdk_window_withdraw _obj'
    touchManagedPtr _obj
    return ()

-- method Window::at_pointer
-- method type : MemberFunction
-- Args : [Arg {argName = "win_x", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "win_y", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_at_pointer" gdk_window_at_pointer :: 
    Ptr Int32 ->                            -- win_x : TBasicType TInt32
    Ptr Int32 ->                            -- win_y : TBasicType TInt32
    IO (Ptr Window)

{-# DEPRECATED windowAtPointer ["(Since version 3.0)","Use gdk_device_get_window_at_position() instead."]#-}
windowAtPointer ::
    (MonadIO m) =>
    m (Window,Int32,Int32)
windowAtPointer  = liftIO $ do
    win_x <- allocMem :: IO (Ptr Int32)
    win_y <- allocMem :: IO (Ptr Int32)
    result <- gdk_window_at_pointer win_x win_y
    checkUnexpectedReturnNULL "gdk_window_at_pointer" result
    result' <- (newObject Window) result
    win_x' <- peek win_x
    win_y' <- peek win_y
    freeMem win_x
    freeMem win_y
    return (result', win_x', win_y')

-- method Window::constrain_size
-- method type : MemberFunction
-- Args : [Arg {argName = "geometry", argType = TInterface "Gdk" "Geometry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gdk" "WindowHints", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_width", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "new_height", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "geometry", argType = TInterface "Gdk" "Geometry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gdk" "WindowHints", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_constrain_size" gdk_window_constrain_size :: 
    Ptr Geometry ->                         -- geometry : TInterface "Gdk" "Geometry"
    CUInt ->                                -- flags : TInterface "Gdk" "WindowHints"
    Int32 ->                                -- width : TBasicType TInt32
    Int32 ->                                -- height : TBasicType TInt32
    Ptr Int32 ->                            -- new_width : TBasicType TInt32
    Ptr Int32 ->                            -- new_height : TBasicType TInt32
    IO ()


windowConstrainSize ::
    (MonadIO m) =>
    Geometry ->                             -- geometry
    [WindowHints] ->                        -- flags
    Int32 ->                                -- width
    Int32 ->                                -- height
    m (Int32,Int32)
windowConstrainSize geometry flags width height = liftIO $ do
    let geometry' = unsafeManagedPtrGetPtr geometry
    let flags' = gflagsToWord flags
    new_width <- allocMem :: IO (Ptr Int32)
    new_height <- allocMem :: IO (Ptr Int32)
    gdk_window_constrain_size geometry' flags' width height new_width new_height
    new_width' <- peek new_width
    new_height' <- peek new_height
    touchManagedPtr geometry
    freeMem new_width
    freeMem new_height
    return (new_width', new_height')

-- method Window::process_all_updates
-- method type : MemberFunction
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_process_all_updates" gdk_window_process_all_updates :: 
    IO ()


windowProcessAllUpdates ::
    (MonadIO m) =>
    m ()
windowProcessAllUpdates  = liftIO $ do
    gdk_window_process_all_updates
    return ()

-- method Window::set_debug_updates
-- method type : MemberFunction
-- Args : [Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_window_set_debug_updates" gdk_window_set_debug_updates :: 
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()


windowSetDebugUpdates ::
    (MonadIO m) =>
    Bool ->                                 -- setting
    m ()
windowSetDebugUpdates setting = liftIO $ do
    let setting' = (fromIntegral . fromEnum) setting
    gdk_window_set_debug_updates setting'
    return ()