{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.GdkX11.Objects.X11Surface
    ( 

-- * Exported types
    X11Surface(..)                          ,
    IsX11Surface                            ,
    toX11Surface                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [beep]("GI.Gdk.Objects.Surface#g:method:beep"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [createCairoContext]("GI.Gdk.Objects.Surface#g:method:createCairoContext"), [createGlContext]("GI.Gdk.Objects.Surface#g:method:createGlContext"), [createSimilarSurface]("GI.Gdk.Objects.Surface#g:method:createSimilarSurface"), [createVulkanContext]("GI.Gdk.Objects.Surface#g:method:createVulkanContext"), [destroy]("GI.Gdk.Objects.Surface#g:method:destroy"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hide]("GI.Gdk.Objects.Surface#g:method:hide"), [isDestroyed]("GI.Gdk.Objects.Surface#g:method:isDestroyed"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [moveToCurrentDesktop]("GI.GdkX11.Objects.X11Surface#g:method:moveToCurrentDesktop"), [moveToDesktop]("GI.GdkX11.Objects.X11Surface#g:method:moveToDesktop"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [queueRender]("GI.Gdk.Objects.Surface#g:method:queueRender"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [requestLayout]("GI.Gdk.Objects.Surface#g:method:requestLayout"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [translateCoordinates]("GI.Gdk.Objects.Surface#g:method:translateCoordinates"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCursor]("GI.Gdk.Objects.Surface#g:method:getCursor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDesktop]("GI.GdkX11.Objects.X11Surface#g:method:getDesktop"), [getDeviceCursor]("GI.Gdk.Objects.Surface#g:method:getDeviceCursor"), [getDevicePosition]("GI.Gdk.Objects.Surface#g:method:getDevicePosition"), [getDisplay]("GI.Gdk.Objects.Surface#g:method:getDisplay"), [getFrameClock]("GI.Gdk.Objects.Surface#g:method:getFrameClock"), [getGroup]("GI.GdkX11.Objects.X11Surface#g:method:getGroup"), [getHeight]("GI.Gdk.Objects.Surface#g:method:getHeight"), [getMapped]("GI.Gdk.Objects.Surface#g:method:getMapped"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getScaleFactor]("GI.Gdk.Objects.Surface#g:method:getScaleFactor"), [getWidth]("GI.Gdk.Objects.Surface#g:method:getWidth"), [getXid]("GI.GdkX11.Objects.X11Surface#g:method:getXid").
-- 
-- ==== Setters
-- [setCursor]("GI.Gdk.Objects.Surface#g:method:setCursor"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDeviceCursor]("GI.Gdk.Objects.Surface#g:method:setDeviceCursor"), [setFrameSyncEnabled]("GI.GdkX11.Objects.X11Surface#g:method:setFrameSyncEnabled"), [setGroup]("GI.GdkX11.Objects.X11Surface#g:method:setGroup"), [setInputRegion]("GI.Gdk.Objects.Surface#g:method:setInputRegion"), [setOpaqueRegion]("GI.Gdk.Objects.Surface#g:method:setOpaqueRegion"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSkipPagerHint]("GI.GdkX11.Objects.X11Surface#g:method:setSkipPagerHint"), [setSkipTaskbarHint]("GI.GdkX11.Objects.X11Surface#g:method:setSkipTaskbarHint"), [setThemeVariant]("GI.GdkX11.Objects.X11Surface#g:method:setThemeVariant"), [setUrgencyHint]("GI.GdkX11.Objects.X11Surface#g:method:setUrgencyHint"), [setUserTime]("GI.GdkX11.Objects.X11Surface#g:method:setUserTime"), [setUtf8Property]("GI.GdkX11.Objects.X11Surface#g:method:setUtf8Property").

#if defined(ENABLE_OVERLOADING)
    ResolveX11SurfaceMethod                 ,
#endif

-- ** getDesktop #method:getDesktop#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceGetDesktopMethodInfo          ,
#endif
    x11SurfaceGetDesktop                    ,


-- ** getGroup #method:getGroup#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceGetGroupMethodInfo            ,
#endif
    x11SurfaceGetGroup                      ,


-- ** getXid #method:getXid#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceGetXidMethodInfo              ,
#endif
    x11SurfaceGetXid                        ,


-- ** lookupForDisplay #method:lookupForDisplay#

    x11SurfaceLookupForDisplay              ,


-- ** moveToCurrentDesktop #method:moveToCurrentDesktop#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceMoveToCurrentDesktopMethodInfo,
#endif
    x11SurfaceMoveToCurrentDesktop          ,


-- ** moveToDesktop #method:moveToDesktop#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceMoveToDesktopMethodInfo       ,
#endif
    x11SurfaceMoveToDesktop                 ,


-- ** setFrameSyncEnabled #method:setFrameSyncEnabled#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceSetFrameSyncEnabledMethodInfo ,
#endif
    x11SurfaceSetFrameSyncEnabled           ,


-- ** setGroup #method:setGroup#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceSetGroupMethodInfo            ,
#endif
    x11SurfaceSetGroup                      ,


-- ** setSkipPagerHint #method:setSkipPagerHint#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceSetSkipPagerHintMethodInfo    ,
#endif
    x11SurfaceSetSkipPagerHint              ,


-- ** setSkipTaskbarHint #method:setSkipTaskbarHint#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceSetSkipTaskbarHintMethodInfo  ,
#endif
    x11SurfaceSetSkipTaskbarHint            ,


-- ** setThemeVariant #method:setThemeVariant#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceSetThemeVariantMethodInfo     ,
#endif
    x11SurfaceSetThemeVariant               ,


-- ** setUrgencyHint #method:setUrgencyHint#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceSetUrgencyHintMethodInfo      ,
#endif
    x11SurfaceSetUrgencyHint                ,


-- ** setUserTime #method:setUserTime#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceSetUserTimeMethodInfo         ,
#endif
    x11SurfaceSetUserTime                   ,


-- ** setUtf8Property #method:setUtf8Property#

#if defined(ENABLE_OVERLOADING)
    X11SurfaceSetUtf8PropertyMethodInfo     ,
#endif
    x11SurfaceSetUtf8Property               ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.Surface as Gdk.Surface
import {-# SOURCE #-} qualified GI.GdkX11.Objects.X11Display as GdkX11.X11Display

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

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

foreign import ccall "gdk_x11_surface_get_type"
    c_gdk_x11_surface_get_type :: IO B.Types.GType

instance B.Types.TypedObject X11Surface where
    glibType :: IO GType
glibType = IO GType
c_gdk_x11_surface_get_type

instance B.Types.GObject X11Surface

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveX11SurfaceMethod (t :: Symbol) (o :: *) :: * where
    ResolveX11SurfaceMethod "beep" o = Gdk.Surface.SurfaceBeepMethodInfo
    ResolveX11SurfaceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveX11SurfaceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveX11SurfaceMethod "createCairoContext" o = Gdk.Surface.SurfaceCreateCairoContextMethodInfo
    ResolveX11SurfaceMethod "createGlContext" o = Gdk.Surface.SurfaceCreateGlContextMethodInfo
    ResolveX11SurfaceMethod "createSimilarSurface" o = Gdk.Surface.SurfaceCreateSimilarSurfaceMethodInfo
    ResolveX11SurfaceMethod "createVulkanContext" o = Gdk.Surface.SurfaceCreateVulkanContextMethodInfo
    ResolveX11SurfaceMethod "destroy" o = Gdk.Surface.SurfaceDestroyMethodInfo
    ResolveX11SurfaceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveX11SurfaceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveX11SurfaceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveX11SurfaceMethod "hide" o = Gdk.Surface.SurfaceHideMethodInfo
    ResolveX11SurfaceMethod "isDestroyed" o = Gdk.Surface.SurfaceIsDestroyedMethodInfo
    ResolveX11SurfaceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveX11SurfaceMethod "moveToCurrentDesktop" o = X11SurfaceMoveToCurrentDesktopMethodInfo
    ResolveX11SurfaceMethod "moveToDesktop" o = X11SurfaceMoveToDesktopMethodInfo
    ResolveX11SurfaceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveX11SurfaceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveX11SurfaceMethod "queueRender" o = Gdk.Surface.SurfaceQueueRenderMethodInfo
    ResolveX11SurfaceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveX11SurfaceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveX11SurfaceMethod "requestLayout" o = Gdk.Surface.SurfaceRequestLayoutMethodInfo
    ResolveX11SurfaceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveX11SurfaceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveX11SurfaceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveX11SurfaceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveX11SurfaceMethod "translateCoordinates" o = Gdk.Surface.SurfaceTranslateCoordinatesMethodInfo
    ResolveX11SurfaceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveX11SurfaceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveX11SurfaceMethod "getCursor" o = Gdk.Surface.SurfaceGetCursorMethodInfo
    ResolveX11SurfaceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveX11SurfaceMethod "getDesktop" o = X11SurfaceGetDesktopMethodInfo
    ResolveX11SurfaceMethod "getDeviceCursor" o = Gdk.Surface.SurfaceGetDeviceCursorMethodInfo
    ResolveX11SurfaceMethod "getDevicePosition" o = Gdk.Surface.SurfaceGetDevicePositionMethodInfo
    ResolveX11SurfaceMethod "getDisplay" o = Gdk.Surface.SurfaceGetDisplayMethodInfo
    ResolveX11SurfaceMethod "getFrameClock" o = Gdk.Surface.SurfaceGetFrameClockMethodInfo
    ResolveX11SurfaceMethod "getGroup" o = X11SurfaceGetGroupMethodInfo
    ResolveX11SurfaceMethod "getHeight" o = Gdk.Surface.SurfaceGetHeightMethodInfo
    ResolveX11SurfaceMethod "getMapped" o = Gdk.Surface.SurfaceGetMappedMethodInfo
    ResolveX11SurfaceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveX11SurfaceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveX11SurfaceMethod "getScaleFactor" o = Gdk.Surface.SurfaceGetScaleFactorMethodInfo
    ResolveX11SurfaceMethod "getWidth" o = Gdk.Surface.SurfaceGetWidthMethodInfo
    ResolveX11SurfaceMethod "getXid" o = X11SurfaceGetXidMethodInfo
    ResolveX11SurfaceMethod "setCursor" o = Gdk.Surface.SurfaceSetCursorMethodInfo
    ResolveX11SurfaceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveX11SurfaceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveX11SurfaceMethod "setDeviceCursor" o = Gdk.Surface.SurfaceSetDeviceCursorMethodInfo
    ResolveX11SurfaceMethod "setFrameSyncEnabled" o = X11SurfaceSetFrameSyncEnabledMethodInfo
    ResolveX11SurfaceMethod "setGroup" o = X11SurfaceSetGroupMethodInfo
    ResolveX11SurfaceMethod "setInputRegion" o = Gdk.Surface.SurfaceSetInputRegionMethodInfo
    ResolveX11SurfaceMethod "setOpaqueRegion" o = Gdk.Surface.SurfaceSetOpaqueRegionMethodInfo
    ResolveX11SurfaceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveX11SurfaceMethod "setSkipPagerHint" o = X11SurfaceSetSkipPagerHintMethodInfo
    ResolveX11SurfaceMethod "setSkipTaskbarHint" o = X11SurfaceSetSkipTaskbarHintMethodInfo
    ResolveX11SurfaceMethod "setThemeVariant" o = X11SurfaceSetThemeVariantMethodInfo
    ResolveX11SurfaceMethod "setUrgencyHint" o = X11SurfaceSetUrgencyHintMethodInfo
    ResolveX11SurfaceMethod "setUserTime" o = X11SurfaceSetUserTimeMethodInfo
    ResolveX11SurfaceMethod "setUtf8Property" o = X11SurfaceSetUtf8PropertyMethodInfo
    ResolveX11SurfaceMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveX11SurfaceMethod t X11Surface, O.OverloadedMethod info X11Surface p, R.HasField t X11Surface p) => R.HasField t X11Surface p where
    getField = O.overloadedMethod @info

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList X11Surface
type instance O.AttributeList X11Surface = X11SurfaceAttributeList
type X11SurfaceAttributeList = ('[ '("cursor", Gdk.Surface.SurfaceCursorPropertyInfo), '("display", Gdk.Surface.SurfaceDisplayPropertyInfo), '("frameClock", Gdk.Surface.SurfaceFrameClockPropertyInfo), '("height", Gdk.Surface.SurfaceHeightPropertyInfo), '("mapped", Gdk.Surface.SurfaceMappedPropertyInfo), '("scaleFactor", Gdk.Surface.SurfaceScaleFactorPropertyInfo), '("width", Gdk.Surface.SurfaceWidthPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "gdk_x11_surface_get_desktop" gdk_x11_surface_get_desktop :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    IO Word32

-- | Gets the number of the workspace /@surface@/ is on.
x11SurfaceGetDesktop ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: a t'GI.Gdk.Objects.Surface.Surface'
    -> m Word32
    -- ^ __Returns:__ the current workspace of /@surface@/
x11SurfaceGetDesktop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> m Word32
x11SurfaceGetDesktop a
surface = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    Word32
result <- Ptr X11Surface -> IO Word32
gdk_x11_surface_get_desktop Ptr X11Surface
surface'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data X11SurfaceGetDesktopMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceGetDesktopMethodInfo a signature where
    overloadedMethod = x11SurfaceGetDesktop

instance O.OverloadedMethodInfo X11SurfaceGetDesktopMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceGetDesktop",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceGetDesktop"
        }


#endif

-- method X11Surface::get_group
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GdkSurface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_get_group" gdk_x11_surface_get_group :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    IO (Ptr Gdk.Surface.Surface)

-- | Returns the group this surface belongs to.
x11SurfaceGetGroup ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: The t'GI.Gdk.Objects.Surface.Surface'
    -> m Gdk.Surface.Surface
    -- ^ __Returns:__ The group of this surface;
x11SurfaceGetGroup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> m Surface
x11SurfaceGetGroup a
surface = IO Surface -> m Surface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    Ptr Surface
result <- Ptr X11Surface -> IO (Ptr Surface)
gdk_x11_surface_get_group Ptr X11Surface
surface'
    Text -> Ptr Surface -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"x11SurfaceGetGroup" Ptr Surface
result
    Surface
result' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Surface -> Surface
Gdk.Surface.Surface) Ptr Surface
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    Surface -> IO Surface
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result'

#if defined(ENABLE_OVERLOADING)
data X11SurfaceGetGroupMethodInfo
instance (signature ~ (m Gdk.Surface.Surface), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceGetGroupMethodInfo a signature where
    overloadedMethod = x11SurfaceGetGroup

instance O.OverloadedMethodInfo X11SurfaceGetGroupMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceGetGroup",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceGetGroup"
        }


#endif

-- method X11Surface::get_xid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a native #GdkSurface."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TULong)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_get_xid" gdk_x11_surface_get_xid :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    IO CULong

-- | Returns the X resource (surface) belonging to a t'GI.Gdk.Objects.Surface.Surface'.
x11SurfaceGetXid ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: a native t'GI.Gdk.Objects.Surface.Surface'.
    -> m CULong
    -- ^ __Returns:__ the ID of /@drawable@/’s X resource.
x11SurfaceGetXid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> m CULong
x11SurfaceGetXid a
surface = IO CULong -> m CULong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    CULong
result <- Ptr X11Surface -> IO CULong
gdk_x11_surface_get_xid Ptr X11Surface
surface'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    CULong -> IO CULong
forall (m :: * -> *) a. Monad m => a -> m a
return CULong
result

#if defined(ENABLE_OVERLOADING)
data X11SurfaceGetXidMethodInfo
instance (signature ~ (m CULong), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceGetXidMethodInfo a signature where
    overloadedMethod = x11SurfaceGetXid

instance O.OverloadedMethodInfo X11SurfaceGetXidMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceGetXid",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceGetXid"
        }


#endif

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

foreign import ccall "gdk_x11_surface_move_to_current_desktop" gdk_x11_surface_move_to_current_desktop :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    IO ()

-- | Moves the surface to the correct workspace when running under a
-- window manager that supports multiple workspaces, as described
-- in the <http://www.freedesktop.org/Standards/wm-spec Extended Window Manager Hints> specification.
-- Will not do anything if the surface is already on all workspaces.
x11SurfaceMoveToCurrentDesktop ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: a t'GI.Gdk.Objects.Surface.Surface'
    -> m ()
x11SurfaceMoveToCurrentDesktop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> m ()
x11SurfaceMoveToCurrentDesktop a
surface = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    Ptr X11Surface -> IO ()
gdk_x11_surface_move_to_current_desktop Ptr X11Surface
surface'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11SurfaceMoveToCurrentDesktopMethodInfo
instance (signature ~ (m ()), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceMoveToCurrentDesktopMethodInfo a signature where
    overloadedMethod = x11SurfaceMoveToCurrentDesktop

instance O.OverloadedMethodInfo X11SurfaceMoveToCurrentDesktopMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceMoveToCurrentDesktop",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceMoveToCurrentDesktop"
        }


#endif

-- method X11Surface::move_to_desktop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkSurface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desktop"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the number of the workspace to move the surface to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_move_to_desktop" gdk_x11_surface_move_to_desktop :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    Word32 ->                               -- desktop : TBasicType TUInt32
    IO ()

-- | Moves the surface to the given workspace when running unde a
-- window manager that supports multiple workspaces, as described
-- in the <http://www.freedesktop.org/Standards/wm-spec Extended Window Manager Hints> specification.
x11SurfaceMoveToDesktop ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: a t'GI.Gdk.Objects.Surface.Surface'
    -> Word32
    -- ^ /@desktop@/: the number of the workspace to move the surface to
    -> m ()
x11SurfaceMoveToDesktop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> Word32 -> m ()
x11SurfaceMoveToDesktop a
surface Word32
desktop = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    Ptr X11Surface -> Word32 -> IO ()
gdk_x11_surface_move_to_desktop Ptr X11Surface
surface' Word32
desktop
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11SurfaceMoveToDesktopMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceMoveToDesktopMethodInfo a signature where
    overloadedMethod = x11SurfaceMoveToDesktop

instance O.OverloadedMethodInfo X11SurfaceMoveToDesktopMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceMoveToDesktop",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceMoveToDesktop"
        }


#endif

-- method X11Surface::set_frame_sync_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a native #GdkSurface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame_sync_enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether frame-synchronization should be enabled"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_set_frame_sync_enabled" gdk_x11_surface_set_frame_sync_enabled :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    CInt ->                                 -- frame_sync_enabled : TBasicType TBoolean
    IO ()

-- | This function can be used to disable frame synchronization for a surface.
-- Normally frame synchronziation will be enabled or disabled based on whether
-- the system has a compositor that supports frame synchronization, but if
-- the surface is not directly managed by the window manager, then frame
-- synchronziation may need to be disabled. This is the case for a surface
-- embedded via the XEMBED protocol.
x11SurfaceSetFrameSyncEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: a native t'GI.Gdk.Objects.Surface.Surface'
    -> Bool
    -- ^ /@frameSyncEnabled@/: whether frame-synchronization should be enabled
    -> m ()
x11SurfaceSetFrameSyncEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> Bool -> m ()
x11SurfaceSetFrameSyncEnabled a
surface Bool
frameSyncEnabled = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    let frameSyncEnabled' :: CInt
frameSyncEnabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
frameSyncEnabled
    Ptr X11Surface -> CInt -> IO ()
gdk_x11_surface_set_frame_sync_enabled Ptr X11Surface
surface' CInt
frameSyncEnabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11SurfaceSetFrameSyncEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceSetFrameSyncEnabledMethodInfo a signature where
    overloadedMethod = x11SurfaceSetFrameSyncEnabled

instance O.OverloadedMethodInfo X11SurfaceSetFrameSyncEnabledMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceSetFrameSyncEnabled",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceSetFrameSyncEnabled"
        }


#endif

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

foreign import ccall "gdk_x11_surface_set_group" gdk_x11_surface_set_group :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    Ptr Gdk.Surface.Surface ->              -- leader : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO ()

-- | Sets the group leader of /@surface@/ to be /@leader@/.
-- See the ICCCM for details.
x11SurfaceSetGroup ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a, Gdk.Surface.IsSurface b) =>
    a
    -- ^ /@surface@/: a native t'GI.Gdk.Objects.Surface.Surface'
    -> b
    -- ^ /@leader@/: a t'GI.Gdk.Objects.Surface.Surface'
    -> m ()
x11SurfaceSetGroup :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsX11Surface a, IsSurface b) =>
a -> b -> m ()
x11SurfaceSetGroup a
surface b
leader = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    Ptr Surface
leader' <- b -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
leader
    Ptr X11Surface -> Ptr Surface -> IO ()
gdk_x11_surface_set_group Ptr X11Surface
surface' Ptr Surface
leader'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
leader
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo X11SurfaceSetGroupMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceSetGroup",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceSetGroup"
        }


#endif

-- method X11Surface::set_skip_pager_hint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkSurface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "skips_pager"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to skip pagers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_set_skip_pager_hint" gdk_x11_surface_set_skip_pager_hint :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    CInt ->                                 -- skips_pager : TBasicType TBoolean
    IO ()

-- | Sets a hint on /@surface@/ that pagers should not
-- display it. See the EWMH for details.
x11SurfaceSetSkipPagerHint ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: a t'GI.Gdk.Objects.Surface.Surface'
    -> Bool
    -- ^ /@skipsPager@/: 'P.True' to skip pagers
    -> m ()
x11SurfaceSetSkipPagerHint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> Bool -> m ()
x11SurfaceSetSkipPagerHint a
surface Bool
skipsPager = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    let skipsPager' :: CInt
skipsPager' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
skipsPager
    Ptr X11Surface -> CInt -> IO ()
gdk_x11_surface_set_skip_pager_hint Ptr X11Surface
surface' CInt
skipsPager'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11SurfaceSetSkipPagerHintMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceSetSkipPagerHintMethodInfo a signature where
    overloadedMethod = x11SurfaceSetSkipPagerHint

instance O.OverloadedMethodInfo X11SurfaceSetSkipPagerHintMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceSetSkipPagerHint",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceSetSkipPagerHint"
        }


#endif

-- method X11Surface::set_skip_taskbar_hint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a native #GdkSurface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "skips_taskbar"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to skip taskbars"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_set_skip_taskbar_hint" gdk_x11_surface_set_skip_taskbar_hint :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    CInt ->                                 -- skips_taskbar : TBasicType TBoolean
    IO ()

-- | Sets a hint on /@surface@/ that taskbars should not
-- display it. See the EWMH for details.
x11SurfaceSetSkipTaskbarHint ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: a native t'GI.Gdk.Objects.Surface.Surface'
    -> Bool
    -- ^ /@skipsTaskbar@/: 'P.True' to skip taskbars
    -> m ()
x11SurfaceSetSkipTaskbarHint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> Bool -> m ()
x11SurfaceSetSkipTaskbarHint a
surface Bool
skipsTaskbar = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    let skipsTaskbar' :: CInt
skipsTaskbar' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
skipsTaskbar
    Ptr X11Surface -> CInt -> IO ()
gdk_x11_surface_set_skip_taskbar_hint Ptr X11Surface
surface' CInt
skipsTaskbar'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11SurfaceSetSkipTaskbarHintMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceSetSkipTaskbarHintMethodInfo a signature where
    overloadedMethod = x11SurfaceSetSkipTaskbarHint

instance O.OverloadedMethodInfo X11SurfaceSetSkipTaskbarHintMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceSetSkipTaskbarHint",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceSetSkipTaskbarHint"
        }


#endif

-- method X11Surface::set_theme_variant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkSurface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "variant"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the theme variant to export"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_set_theme_variant" gdk_x11_surface_set_theme_variant :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    CString ->                              -- variant : TBasicType TUTF8
    IO ()

-- | GTK applications can request a dark theme variant. In order to
-- make other applications - namely window managers using GTK for
-- themeing - aware of this choice, GTK uses this function to
-- export the requested theme variant as _GTK_THEME_VARIANT property
-- on toplevel surfaces.
-- 
-- Note that this property is automatically updated by GTK, so this
-- function should only be used by applications which do not use GTK
-- to create toplevel surfaces.
x11SurfaceSetThemeVariant ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: a t'GI.Gdk.Objects.Surface.Surface'
    -> T.Text
    -- ^ /@variant@/: the theme variant to export
    -> m ()
x11SurfaceSetThemeVariant :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> Text -> m ()
x11SurfaceSetThemeVariant a
surface Text
variant = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    CString
variant' <- Text -> IO CString
textToCString Text
variant
    Ptr X11Surface -> CString -> IO ()
gdk_x11_surface_set_theme_variant Ptr X11Surface
surface' CString
variant'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
variant'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo X11SurfaceSetThemeVariantMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceSetThemeVariant",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceSetThemeVariant"
        }


#endif

-- method X11Surface::set_urgency_hint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a native #GdkSurface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "urgent"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to indicate urgenct attention needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_set_urgency_hint" gdk_x11_surface_set_urgency_hint :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    CInt ->                                 -- urgent : TBasicType TBoolean
    IO ()

-- | Sets a hint on /@surface@/ that it needs user attention.
-- See the ICCCM for details.
x11SurfaceSetUrgencyHint ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: a native t'GI.Gdk.Objects.Surface.Surface'
    -> Bool
    -- ^ /@urgent@/: 'P.True' to indicate urgenct attention needed
    -> m ()
x11SurfaceSetUrgencyHint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> Bool -> m ()
x11SurfaceSetUrgencyHint a
surface Bool
urgent = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    let urgent' :: CInt
urgent' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
urgent
    Ptr X11Surface -> CInt -> IO ()
gdk_x11_surface_set_urgency_hint Ptr X11Surface
surface' CInt
urgent'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11SurfaceSetUrgencyHintMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceSetUrgencyHintMethodInfo a signature where
    overloadedMethod = x11SurfaceSetUrgencyHint

instance O.OverloadedMethodInfo X11SurfaceSetUrgencyHintMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceSetUrgencyHint",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceSetUrgencyHint"
        }


#endif

-- method X11Surface::set_user_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A toplevel #GdkSurface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "An XServer timestamp to which the property should be set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_set_user_time" gdk_x11_surface_set_user_time :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    Word32 ->                               -- timestamp : TBasicType TUInt32
    IO ()

-- | The application can use this call to update the _NET_WM_USER_TIME
-- property on a toplevel surface.  This property stores an Xserver
-- time which represents the time of the last user input event
-- received for this surface.  This property may be used by the window
-- manager to alter the focus, stacking, and\/or placement behavior of
-- surfaces when they are mapped depending on whether the new surface
-- was created by a user action or is a \"pop-up\" surface activated by a
-- timer or some other event.
-- 
-- Note that this property is automatically updated by GDK, so this
-- function should only be used by applications which handle input
-- events bypassing GDK.
x11SurfaceSetUserTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: A toplevel t'GI.Gdk.Objects.Surface.Surface'
    -> Word32
    -- ^ /@timestamp@/: An XServer timestamp to which the property should be set
    -> m ()
x11SurfaceSetUserTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> Word32 -> m ()
x11SurfaceSetUserTime a
surface Word32
timestamp = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    Ptr X11Surface -> Word32 -> IO ()
gdk_x11_surface_set_user_time Ptr X11Surface
surface' Word32
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11SurfaceSetUserTimeMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceSetUserTimeMethodInfo a signature where
    overloadedMethod = x11SurfaceSetUserTime

instance O.OverloadedMethodInfo X11SurfaceSetUserTimeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceSetUserTime",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceSetUserTime"
        }


#endif

-- method X11Surface::set_utf8_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkSurface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Property name, will be interned as an X atom"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Property value, or %NULL to delete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_set_utf8_property" gdk_x11_surface_set_utf8_property :: 
    Ptr X11Surface ->                       -- surface : TInterface (Name {namespace = "GdkX11", name = "X11Surface"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO ()

-- | This function modifies or removes an arbitrary X11 window
-- property of type UTF8_STRING.  If the given /@surface@/ is
-- not a toplevel surface, it is ignored.
x11SurfaceSetUtf8Property ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Surface a) =>
    a
    -- ^ /@surface@/: a t'GI.Gdk.Objects.Surface.Surface'
    -> T.Text
    -- ^ /@name@/: Property name, will be interned as an X atom
    -> Maybe (T.Text)
    -- ^ /@value@/: Property value, or 'P.Nothing' to delete
    -> m ()
x11SurfaceSetUtf8Property :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Surface a) =>
a -> Text -> Maybe Text -> m ()
x11SurfaceSetUtf8Property a
surface Text
name Maybe Text
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Surface
surface' <- a -> IO (Ptr X11Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
maybeValue <- case Maybe Text
value of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jValue -> do
            CString
jValue' <- Text -> IO CString
textToCString Text
jValue
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jValue'
    Ptr X11Surface -> CString -> CString -> IO ()
gdk_x11_surface_set_utf8_property Ptr X11Surface
surface' CString
name' CString
maybeValue
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeValue
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11SurfaceSetUtf8PropertyMethodInfo
instance (signature ~ (T.Text -> Maybe (T.Text) -> m ()), MonadIO m, IsX11Surface a) => O.OverloadedMethod X11SurfaceSetUtf8PropertyMethodInfo a signature where
    overloadedMethod = x11SurfaceSetUtf8Property

instance O.OverloadedMethodInfo X11SurfaceSetUtf8PropertyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkX11.Objects.X11Surface.x11SurfaceSetUtf8Property",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkx11-4.0.3/docs/GI-GdkX11-Objects-X11Surface.html#v:x11SurfaceSetUtf8Property"
        }


#endif

-- method X11Surface::lookup_for_display
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GdkDisplay corresponding to the\n          window handle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "window"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an Xlib Window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkX11" , name = "X11Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_surface_lookup_for_display" gdk_x11_surface_lookup_for_display :: 
    Ptr GdkX11.X11Display.X11Display ->     -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    CULong ->                               -- window : TBasicType TULong
    IO (Ptr X11Surface)

-- | Looks up the t'GI.Gdk.Objects.Surface.Surface' that wraps the given native window handle.
x11SurfaceLookupForDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, GdkX11.X11Display.IsX11Display a) =>
    a
    -- ^ /@display@/: the t'GI.Gdk.Objects.Display.Display' corresponding to the
    --           window handle
    -> CULong
    -- ^ /@window@/: an Xlib Window
    -> m X11Surface
    -- ^ __Returns:__ the t'GI.Gdk.Objects.Surface.Surface' wrapper for the native
    --    window, or 'P.Nothing' if there is none.
x11SurfaceLookupForDisplay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsX11Display a) =>
a -> CULong -> m X11Surface
x11SurfaceLookupForDisplay a
display CULong
window = IO X11Surface -> m X11Surface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO X11Surface -> m X11Surface) -> IO X11Surface -> m X11Surface
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr X11Surface
result <- Ptr X11Display -> CULong -> IO (Ptr X11Surface)
gdk_x11_surface_lookup_for_display Ptr X11Display
display' CULong
window
    Text -> Ptr X11Surface -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"x11SurfaceLookupForDisplay" Ptr X11Surface
result
    X11Surface
result' <- ((ManagedPtr X11Surface -> X11Surface)
-> Ptr X11Surface -> IO X11Surface
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr X11Surface -> X11Surface
X11Surface) Ptr X11Surface
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    X11Surface -> IO X11Surface
forall (m :: * -> *) a. Monad m => a -> m a
return X11Surface
result'

#if defined(ENABLE_OVERLOADING)
#endif