{-# 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.X11Display
    ( 

-- * Exported types
    X11Display(..)                          ,
    IsX11Display                            ,
    toX11Display                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveX11DisplayMethod                 ,
#endif


-- ** errorTrapPop #method:errorTrapPop#

#if defined(ENABLE_OVERLOADING)
    X11DisplayErrorTrapPopMethodInfo        ,
#endif
    x11DisplayErrorTrapPop                  ,


-- ** errorTrapPopIgnored #method:errorTrapPopIgnored#

#if defined(ENABLE_OVERLOADING)
    X11DisplayErrorTrapPopIgnoredMethodInfo ,
#endif
    x11DisplayErrorTrapPopIgnored           ,


-- ** errorTrapPush #method:errorTrapPush#

#if defined(ENABLE_OVERLOADING)
    X11DisplayErrorTrapPushMethodInfo       ,
#endif
    x11DisplayErrorTrapPush                 ,


-- ** getGlxVersion #method:getGlxVersion#

    x11DisplayGetGlxVersion                 ,


-- ** getPrimaryMonitor #method:getPrimaryMonitor#

    x11DisplayGetPrimaryMonitor             ,


-- ** getScreen #method:getScreen#

    x11DisplayGetScreen                     ,


-- ** getStartupNotificationId #method:getStartupNotificationId#

#if defined(ENABLE_OVERLOADING)
    X11DisplayGetStartupNotificationIdMethodInfo,
#endif
    x11DisplayGetStartupNotificationId      ,


-- ** getUserTime #method:getUserTime#

#if defined(ENABLE_OVERLOADING)
    X11DisplayGetUserTimeMethodInfo         ,
#endif
    x11DisplayGetUserTime                   ,


-- ** getXcursor #method:getXcursor#

#if defined(ENABLE_OVERLOADING)
    X11DisplayGetXcursorMethodInfo          ,
#endif
    x11DisplayGetXcursor                    ,


-- ** getXdisplay #method:getXdisplay#

#if defined(ENABLE_OVERLOADING)
    X11DisplayGetXdisplayMethodInfo         ,
#endif
    x11DisplayGetXdisplay                   ,


-- ** getXrootwindow #method:getXrootwindow#

#if defined(ENABLE_OVERLOADING)
    X11DisplayGetXrootwindowMethodInfo      ,
#endif
    x11DisplayGetXrootwindow                ,


-- ** getXscreen #method:getXscreen#

#if defined(ENABLE_OVERLOADING)
    X11DisplayGetXscreenMethodInfo          ,
#endif
    x11DisplayGetXscreen                    ,


-- ** grab #method:grab#

#if defined(ENABLE_OVERLOADING)
    X11DisplayGrabMethodInfo                ,
#endif
    x11DisplayGrab                          ,


-- ** open #method:open#

    x11DisplayOpen                          ,


-- ** setCursorTheme #method:setCursorTheme#

#if defined(ENABLE_OVERLOADING)
    X11DisplaySetCursorThemeMethodInfo      ,
#endif
    x11DisplaySetCursorTheme                ,


-- ** setProgramClass #method:setProgramClass#

    x11DisplaySetProgramClass               ,


-- ** setStartupNotificationId #method:setStartupNotificationId#

#if defined(ENABLE_OVERLOADING)
    X11DisplaySetStartupNotificationIdMethodInfo,
#endif
    x11DisplaySetStartupNotificationId      ,


-- ** setSurfaceScale #method:setSurfaceScale#

#if defined(ENABLE_OVERLOADING)
    X11DisplaySetSurfaceScaleMethodInfo     ,
#endif
    x11DisplaySetSurfaceScale               ,


-- ** stringToCompoundText #method:stringToCompoundText#

#if defined(ENABLE_OVERLOADING)
    X11DisplayStringToCompoundTextMethodInfo,
#endif
    x11DisplayStringToCompoundText          ,


-- ** textPropertyToTextList #method:textPropertyToTextList#

#if defined(ENABLE_OVERLOADING)
    X11DisplayTextPropertyToTextListMethodInfo,
#endif
    x11DisplayTextPropertyToTextList        ,


-- ** ungrab #method:ungrab#

#if defined(ENABLE_OVERLOADING)
    X11DisplayUngrabMethodInfo              ,
#endif
    x11DisplayUngrab                        ,


-- ** utf8ToCompoundText #method:utf8ToCompoundText#

#if defined(ENABLE_OVERLOADING)
    X11DisplayUtf8ToCompoundTextMethodInfo  ,
#endif
    x11DisplayUtf8ToCompoundText            ,




 -- * Signals
-- ** xevent #signal:xevent#

    C_X11DisplayXeventCallback              ,
    X11DisplayXeventCallback                ,
#if defined(ENABLE_OVERLOADING)
    X11DisplayXeventSignalInfo              ,
#endif
    afterX11DisplayXevent                   ,
    genClosure_X11DisplayXevent             ,
    mk_X11DisplayXeventCallback             ,
    noX11DisplayXeventCallback              ,
    onX11DisplayXevent                      ,
    wrap_X11DisplayXeventCallback           ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
import qualified GI.Gdk.Objects.Display as Gdk.Display
import qualified GI.Gdk.Objects.Monitor as Gdk.Monitor
import {-# SOURCE #-} qualified GI.GdkX11.Objects.X11Screen as GdkX11.X11Screen
import qualified GI.Xlib.Structs.Display as Xlib.Display
import qualified GI.Xlib.Structs.Screen as Xlib.Screen

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

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

foreign import ccall "gdk_x11_display_get_type"
    c_gdk_x11_display_get_type :: IO B.Types.GType

instance B.Types.TypedObject X11Display where
    glibType :: IO GType
glibType = IO GType
c_gdk_x11_display_get_type

instance B.Types.GObject X11Display

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

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

instance O.HasParentTypes X11Display
type instance O.ParentTypes X11Display = '[Gdk.Display.Display, GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveX11DisplayMethod (t :: Symbol) (o :: *) :: * where
    ResolveX11DisplayMethod "beep" o = Gdk.Display.DisplayBeepMethodInfo
    ResolveX11DisplayMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveX11DisplayMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveX11DisplayMethod "close" o = Gdk.Display.DisplayCloseMethodInfo
    ResolveX11DisplayMethod "deviceIsGrabbed" o = Gdk.Display.DisplayDeviceIsGrabbedMethodInfo
    ResolveX11DisplayMethod "errorTrapPop" o = X11DisplayErrorTrapPopMethodInfo
    ResolveX11DisplayMethod "errorTrapPopIgnored" o = X11DisplayErrorTrapPopIgnoredMethodInfo
    ResolveX11DisplayMethod "errorTrapPush" o = X11DisplayErrorTrapPushMethodInfo
    ResolveX11DisplayMethod "flush" o = Gdk.Display.DisplayFlushMethodInfo
    ResolveX11DisplayMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveX11DisplayMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveX11DisplayMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveX11DisplayMethod "grab" o = X11DisplayGrabMethodInfo
    ResolveX11DisplayMethod "hasPending" o = Gdk.Display.DisplayHasPendingMethodInfo
    ResolveX11DisplayMethod "isClosed" o = Gdk.Display.DisplayIsClosedMethodInfo
    ResolveX11DisplayMethod "isComposited" o = Gdk.Display.DisplayIsCompositedMethodInfo
    ResolveX11DisplayMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveX11DisplayMethod "isRgba" o = Gdk.Display.DisplayIsRgbaMethodInfo
    ResolveX11DisplayMethod "listSeats" o = Gdk.Display.DisplayListSeatsMethodInfo
    ResolveX11DisplayMethod "mapKeycode" o = Gdk.Display.DisplayMapKeycodeMethodInfo
    ResolveX11DisplayMethod "mapKeyval" o = Gdk.Display.DisplayMapKeyvalMethodInfo
    ResolveX11DisplayMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveX11DisplayMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveX11DisplayMethod "notifyStartupComplete" o = Gdk.Display.DisplayNotifyStartupCompleteMethodInfo
    ResolveX11DisplayMethod "peekEvent" o = Gdk.Display.DisplayPeekEventMethodInfo
    ResolveX11DisplayMethod "putEvent" o = Gdk.Display.DisplayPutEventMethodInfo
    ResolveX11DisplayMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveX11DisplayMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveX11DisplayMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveX11DisplayMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveX11DisplayMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveX11DisplayMethod "stringToCompoundText" o = X11DisplayStringToCompoundTextMethodInfo
    ResolveX11DisplayMethod "supportsInputShapes" o = Gdk.Display.DisplaySupportsInputShapesMethodInfo
    ResolveX11DisplayMethod "sync" o = Gdk.Display.DisplaySyncMethodInfo
    ResolveX11DisplayMethod "textPropertyToTextList" o = X11DisplayTextPropertyToTextListMethodInfo
    ResolveX11DisplayMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveX11DisplayMethod "ungrab" o = X11DisplayUngrabMethodInfo
    ResolveX11DisplayMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveX11DisplayMethod "utf8ToCompoundText" o = X11DisplayUtf8ToCompoundTextMethodInfo
    ResolveX11DisplayMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveX11DisplayMethod "getAppLaunchContext" o = Gdk.Display.DisplayGetAppLaunchContextMethodInfo
    ResolveX11DisplayMethod "getClipboard" o = Gdk.Display.DisplayGetClipboardMethodInfo
    ResolveX11DisplayMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveX11DisplayMethod "getDefaultGroup" o = Gdk.Display.DisplayGetDefaultGroupMethodInfo
    ResolveX11DisplayMethod "getDefaultSeat" o = Gdk.Display.DisplayGetDefaultSeatMethodInfo
    ResolveX11DisplayMethod "getEvent" o = Gdk.Display.DisplayGetEventMethodInfo
    ResolveX11DisplayMethod "getMonitorAtSurface" o = Gdk.Display.DisplayGetMonitorAtSurfaceMethodInfo
    ResolveX11DisplayMethod "getMonitors" o = Gdk.Display.DisplayGetMonitorsMethodInfo
    ResolveX11DisplayMethod "getName" o = Gdk.Display.DisplayGetNameMethodInfo
    ResolveX11DisplayMethod "getPrimaryClipboard" o = Gdk.Display.DisplayGetPrimaryClipboardMethodInfo
    ResolveX11DisplayMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveX11DisplayMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveX11DisplayMethod "getSetting" o = Gdk.Display.DisplayGetSettingMethodInfo
    ResolveX11DisplayMethod "getStartupNotificationId" o = X11DisplayGetStartupNotificationIdMethodInfo
    ResolveX11DisplayMethod "getUserTime" o = X11DisplayGetUserTimeMethodInfo
    ResolveX11DisplayMethod "getXcursor" o = X11DisplayGetXcursorMethodInfo
    ResolveX11DisplayMethod "getXdisplay" o = X11DisplayGetXdisplayMethodInfo
    ResolveX11DisplayMethod "getXrootwindow" o = X11DisplayGetXrootwindowMethodInfo
    ResolveX11DisplayMethod "getXscreen" o = X11DisplayGetXscreenMethodInfo
    ResolveX11DisplayMethod "setCursorTheme" o = X11DisplaySetCursorThemeMethodInfo
    ResolveX11DisplayMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveX11DisplayMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveX11DisplayMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveX11DisplayMethod "setStartupNotificationId" o = X11DisplaySetStartupNotificationIdMethodInfo
    ResolveX11DisplayMethod "setSurfaceScale" o = X11DisplaySetSurfaceScaleMethodInfo
    ResolveX11DisplayMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal X11Display::xevent
-- | The [xevent](#g:signal:xevent) signal is a low level signal that is emitted
-- whenever an XEvent has been received.
-- 
-- When handlers to this signal return 'P.True', no other handlers will be
-- invoked. In particular, the default handler for this function is
-- GDK\'s own event handling mechanism, so by returning 'P.True' for an event
-- that GDK expects to translate, you may break GDK and\/or GTK+ in
-- interesting ways. You have been warned.
-- 
-- If you want this signal handler to queue a t'GI.Gdk.Objects.Event.Event', you can use
-- 'GI.Gdk.Objects.Display.displayPutEvent'.
-- 
-- If you are interested in X GenericEvents, bear in mind that
-- @/XGetEventData()/@ has been already called on the event, and
-- @/XFreeEventData()/@ will be called afterwards.
type X11DisplayXeventCallback =
    Ptr ()
    -- ^ /@xevent@/: a pointer to the XEvent to process
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to stop other handlers from being invoked for the event.
    --   'P.False' to propagate the event further.

-- | A convenience synonym for @`Nothing` :: `Maybe` `X11DisplayXeventCallback`@.
noX11DisplayXeventCallback :: Maybe X11DisplayXeventCallback
noX11DisplayXeventCallback :: Maybe X11DisplayXeventCallback
noX11DisplayXeventCallback = Maybe X11DisplayXeventCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_X11DisplayXevent :: MonadIO m => X11DisplayXeventCallback -> m (GClosure C_X11DisplayXeventCallback)
genClosure_X11DisplayXevent :: X11DisplayXeventCallback -> m (GClosure C_X11DisplayXeventCallback)
genClosure_X11DisplayXevent X11DisplayXeventCallback
cb = IO (GClosure C_X11DisplayXeventCallback)
-> m (GClosure C_X11DisplayXeventCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_X11DisplayXeventCallback)
 -> m (GClosure C_X11DisplayXeventCallback))
-> IO (GClosure C_X11DisplayXeventCallback)
-> m (GClosure C_X11DisplayXeventCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_X11DisplayXeventCallback
cb' = X11DisplayXeventCallback -> C_X11DisplayXeventCallback
wrap_X11DisplayXeventCallback X11DisplayXeventCallback
cb
    C_X11DisplayXeventCallback
-> IO (FunPtr C_X11DisplayXeventCallback)
mk_X11DisplayXeventCallback C_X11DisplayXeventCallback
cb' IO (FunPtr C_X11DisplayXeventCallback)
-> (FunPtr C_X11DisplayXeventCallback
    -> IO (GClosure C_X11DisplayXeventCallback))
-> IO (GClosure C_X11DisplayXeventCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_X11DisplayXeventCallback
-> IO (GClosure C_X11DisplayXeventCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `X11DisplayXeventCallback` into a `C_X11DisplayXeventCallback`.
wrap_X11DisplayXeventCallback ::
    X11DisplayXeventCallback ->
    C_X11DisplayXeventCallback
wrap_X11DisplayXeventCallback :: X11DisplayXeventCallback -> C_X11DisplayXeventCallback
wrap_X11DisplayXeventCallback X11DisplayXeventCallback
_cb Ptr ()
_ Ptr ()
xevent Ptr ()
_ = do
    Bool
result <- X11DisplayXeventCallback
_cb  Ptr ()
xevent
    let result' :: CInt
result' = (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
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


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

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


#if defined(ENABLE_OVERLOADING)
data X11DisplayXeventSignalInfo
instance SignalInfo X11DisplayXeventSignalInfo where
    type HaskellCallbackType X11DisplayXeventSignalInfo = X11DisplayXeventCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_X11DisplayXeventCallback cb
        cb'' <- mk_X11DisplayXeventCallback cb'
        connectSignalFunPtr obj "xevent" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList X11Display
type instance O.AttributeList X11Display = X11DisplayAttributeList
type X11DisplayAttributeList = ('[ '("composited", Gdk.Display.DisplayCompositedPropertyInfo), '("inputShapes", Gdk.Display.DisplayInputShapesPropertyInfo), '("rgba", Gdk.Display.DisplayRgbaPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList X11Display = X11DisplaySignalList
type X11DisplaySignalList = ('[ '("closed", Gdk.Display.DisplayClosedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("opened", Gdk.Display.DisplayOpenedSignalInfo), '("seatAdded", Gdk.Display.DisplaySeatAddedSignalInfo), '("seatRemoved", Gdk.Display.DisplaySeatRemovedSignalInfo), '("settingChanged", Gdk.Display.DisplaySettingChangedSignalInfo), '("xevent", X11DisplayXeventSignalInfo)] :: [(Symbol, *)])

#endif

-- method X11Display::error_trap_pop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the display" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_display_error_trap_pop" gdk_x11_display_error_trap_pop :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    IO Int32

-- | Pops the error trap pushed by 'GI.GdkX11.Objects.X11Display.x11DisplayErrorTrapPush'.
-- Will @/XSync()/@ if necessary and will always block until
-- the error is known to have occurred or not occurred,
-- so the error code can be returned.
-- 
-- If you don’t need to use the return value,
-- 'GI.GdkX11.Objects.X11Display.x11DisplayErrorTrapPopIgnored' would be more efficient.
-- 
-- See @/gdk_error_trap_pop()/@ for the all-displays-at-once
-- equivalent.
x11DisplayErrorTrapPop ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: the display
    -> m Int32
    -- ^ __Returns:__ X error code or 0 on success
x11DisplayErrorTrapPop :: a -> m Int32
x11DisplayErrorTrapPop a
display = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Int32
result <- Ptr X11Display -> IO Int32
gdk_x11_display_error_trap_pop Ptr X11Display
display'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data X11DisplayErrorTrapPopMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayErrorTrapPopMethodInfo a signature where
    overloadedMethod = x11DisplayErrorTrapPop

#endif

-- method X11Display::error_trap_pop_ignored
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the display" , 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_display_error_trap_pop_ignored" gdk_x11_display_error_trap_pop_ignored :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    IO ()

-- | Pops the error trap pushed by 'GI.GdkX11.Objects.X11Display.x11DisplayErrorTrapPush'.
-- Does not block to see if an error occurred; merely records the
-- range of requests to ignore errors for, and ignores those errors
-- if they arrive asynchronously.
-- 
-- See @/gdk_error_trap_pop_ignored()/@ for the all-displays-at-once
-- equivalent.
x11DisplayErrorTrapPopIgnored ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: the display
    -> m ()
x11DisplayErrorTrapPopIgnored :: a -> m ()
x11DisplayErrorTrapPopIgnored a
display = 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 X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr X11Display -> IO ()
gdk_x11_display_error_trap_pop_ignored Ptr X11Display
display'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11DisplayErrorTrapPopIgnoredMethodInfo
instance (signature ~ (m ()), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayErrorTrapPopIgnoredMethodInfo a signature where
    overloadedMethod = x11DisplayErrorTrapPopIgnored

#endif

-- method X11Display::error_trap_push
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , 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_display_error_trap_push" gdk_x11_display_error_trap_push :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    IO ()

-- | Begins a range of X requests on /@display@/ for which X error events
-- will be ignored. Unignored errors (when no trap is pushed) will abort
-- the application. Use 'GI.GdkX11.Objects.X11Display.x11DisplayErrorTrapPop' or
-- 'GI.GdkX11.Objects.X11Display.x11DisplayErrorTrapPopIgnored'to lift a trap pushed
-- with this function.
-- 
-- See also @/gdk_error_trap_push()/@ to push a trap on all displays.
x11DisplayErrorTrapPush ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m ()
x11DisplayErrorTrapPush :: a -> m ()
x11DisplayErrorTrapPush a
display = 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 X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr X11Display -> IO ()
gdk_x11_display_error_trap_push Ptr X11Display
display'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11DisplayErrorTrapPushMethodInfo
instance (signature ~ (m ()), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayErrorTrapPushMethodInfo a signature where
    overloadedMethod = x11DisplayErrorTrapPush

#endif

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

foreign import ccall "gdk_x11_display_get_startup_notification_id" gdk_x11_display_get_startup_notification_id :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    IO CString

-- | Gets the startup notification ID for a display.
x11DisplayGetStartupNotificationId ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m T.Text
    -- ^ __Returns:__ the startup notification ID for /@display@/
x11DisplayGetStartupNotificationId :: a -> m Text
x11DisplayGetStartupNotificationId a
display = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
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
    CString
result <- Ptr X11Display -> IO CString
gdk_x11_display_get_startup_notification_id Ptr X11Display
display'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"x11DisplayGetStartupNotificationId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data X11DisplayGetStartupNotificationIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayGetStartupNotificationIdMethodInfo a signature where
    overloadedMethod = x11DisplayGetStartupNotificationId

#endif

-- method X11Display::get_user_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , 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_display_get_user_time" gdk_x11_display_get_user_time :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    IO Word32

-- | Returns the timestamp of the last user interaction on
-- /@display@/. The timestamp is taken from events caused
-- by user interaction such as key presses or pointer
-- movements. See 'GI.GdkX11.Objects.X11Surface.x11SurfaceSetUserTime'.
x11DisplayGetUserTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m Word32
    -- ^ __Returns:__ the timestamp of the last user interaction
x11DisplayGetUserTime :: a -> m Word32
x11DisplayGetUserTime a
display = 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 X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Word32
result <- Ptr X11Display -> IO Word32
gdk_x11_display_get_user_time Ptr X11Display
display'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data X11DisplayGetUserTimeMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayGetUserTimeMethodInfo a signature where
    overloadedMethod = x11DisplayGetUserTime

#endif

-- method X11Display::get_xcursor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cursor"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Cursor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkCursor." , 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_display_get_xcursor" gdk_x11_display_get_xcursor :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    Ptr Gdk.Cursor.Cursor ->                -- cursor : TInterface (Name {namespace = "Gdk", name = "Cursor"})
    IO CULong

-- | Returns the X cursor belonging to a t'GI.Gdk.Objects.Cursor.Cursor', potentially
-- creating the cursor.
-- 
-- Be aware that the returned cursor may not be unique to /@cursor@/.
-- It may for example be shared with its fallback cursor. On old
-- X servers that don\'t support the XCursor extension, all cursors
-- may even fall back to a few default cursors.
x11DisplayGetXcursor ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a, Gdk.Cursor.IsCursor b) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> b
    -- ^ /@cursor@/: a t'GI.Gdk.Objects.Cursor.Cursor'.
    -> m CULong
    -- ^ __Returns:__ an Xlib Cursor.
x11DisplayGetXcursor :: a -> b -> m SignalHandlerId
x11DisplayGetXcursor a
display b
cursor = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr Cursor
cursor' <- b -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
cursor
    SignalHandlerId
result <- Ptr X11Display -> Ptr Cursor -> IO SignalHandlerId
gdk_x11_display_get_xcursor Ptr X11Display
display' Ptr Cursor
cursor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
cursor
    SignalHandlerId -> IO SignalHandlerId
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandlerId
result

#if defined(ENABLE_OVERLOADING)
data X11DisplayGetXcursorMethodInfo
instance (signature ~ (b -> m CULong), MonadIO m, IsX11Display a, Gdk.Cursor.IsCursor b) => O.MethodInfo X11DisplayGetXcursorMethodInfo a signature where
    overloadedMethod = x11DisplayGetXcursor

#endif

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

foreign import ccall "gdk_x11_display_get_xdisplay" gdk_x11_display_get_xdisplay :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    IO (Ptr Xlib.Display.Display)

-- | Returns the X display of a t'GI.Gdk.Objects.Display.Display'.
x11DisplayGetXdisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m Xlib.Display.Display
    -- ^ __Returns:__ an X display
x11DisplayGetXdisplay :: a -> m Display
x11DisplayGetXdisplay a
display = IO Display -> m Display
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Display -> m Display) -> IO Display -> m Display
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 Display
result <- Ptr X11Display -> IO (Ptr Display)
gdk_x11_display_get_xdisplay Ptr X11Display
display'
    Text -> Ptr Display -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"x11DisplayGetXdisplay" Ptr Display
result
    Display
result' <- ((ManagedPtr Display -> Display) -> Ptr Display -> IO Display
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Display -> Display
Xlib.Display.Display) Ptr Display
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    Display -> IO Display
forall (m :: * -> *) a. Monad m => a -> m a
return Display
result'

#if defined(ENABLE_OVERLOADING)
data X11DisplayGetXdisplayMethodInfo
instance (signature ~ (m Xlib.Display.Display), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayGetXdisplayMethodInfo a signature where
    overloadedMethod = x11DisplayGetXdisplay

#endif

-- method X11Display::get_xrootwindow
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , 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_display_get_xrootwindow" gdk_x11_display_get_xrootwindow :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    IO CULong

-- | Returns the root X window used by t'GI.Gdk.Objects.Display.Display'.
x11DisplayGetXrootwindow ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m CULong
    -- ^ __Returns:__ an X Window
x11DisplayGetXrootwindow :: a -> m SignalHandlerId
x11DisplayGetXrootwindow a
display = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    SignalHandlerId
result <- Ptr X11Display -> IO SignalHandlerId
gdk_x11_display_get_xrootwindow Ptr X11Display
display'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    SignalHandlerId -> IO SignalHandlerId
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandlerId
result

#if defined(ENABLE_OVERLOADING)
data X11DisplayGetXrootwindowMethodInfo
instance (signature ~ (m CULong), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayGetXrootwindowMethodInfo a signature where
    overloadedMethod = x11DisplayGetXrootwindow

#endif

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

foreign import ccall "gdk_x11_display_get_xscreen" gdk_x11_display_get_xscreen :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    IO (Ptr Xlib.Screen.Screen)

-- | Returns the X Screen used by t'GI.Gdk.Objects.Display.Display'.
x11DisplayGetXscreen ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m Xlib.Screen.Screen
    -- ^ __Returns:__ an X Screen
x11DisplayGetXscreen :: a -> m Screen
x11DisplayGetXscreen a
display = IO Screen -> m Screen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Screen -> m Screen) -> IO Screen -> m Screen
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 Screen
result <- Ptr X11Display -> IO (Ptr Screen)
gdk_x11_display_get_xscreen Ptr X11Display
display'
    Text -> Ptr Screen -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"x11DisplayGetXscreen" Ptr Screen
result
    Screen
result' <- ((ManagedPtr Screen -> Screen) -> Ptr Screen -> IO Screen
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Screen -> Screen
Xlib.Screen.Screen) Ptr Screen
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    Screen -> IO Screen
forall (m :: * -> *) a. Monad m => a -> m a
return Screen
result'

#if defined(ENABLE_OVERLOADING)
data X11DisplayGetXscreenMethodInfo
instance (signature ~ (m Xlib.Screen.Screen), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayGetXscreenMethodInfo a signature where
    overloadedMethod = x11DisplayGetXscreen

#endif

-- method X11Display::grab
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , 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_display_grab" gdk_x11_display_grab :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    IO ()

-- | Call @/XGrabServer()/@ on /@display@/.
-- To ungrab the display again, use 'GI.GdkX11.Objects.X11Display.x11DisplayUngrab'.
-- 
-- 'GI.GdkX11.Objects.X11Display.x11DisplayGrab'\/'GI.GdkX11.Objects.X11Display.x11DisplayUngrab' calls can be nested.
x11DisplayGrab ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m ()
x11DisplayGrab :: a -> m ()
x11DisplayGrab a
display = 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 X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr X11Display -> IO ()
gdk_x11_display_grab Ptr X11Display
display'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11DisplayGrabMethodInfo
instance (signature ~ (m ()), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayGrabMethodInfo a signature where
    overloadedMethod = x11DisplayGrab

#endif

-- method X11Display::set_cursor_theme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "theme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name of the cursor theme to use, or %NULL to unset\n        a previously set value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the cursor size to use, or 0 to keep the previous size"
--                 , 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_display_set_cursor_theme" gdk_x11_display_set_cursor_theme :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    CString ->                              -- theme : TBasicType TUTF8
    Int32 ->                                -- size : TBasicType TInt
    IO ()

-- | Sets the cursor theme from which the images for cursor
-- should be taken.
-- 
-- If the windowing system supports it, existing cursors created
-- with @/gdk_cursor_new()/@, @/gdk_cursor_new_for_display()/@ and
-- 'GI.Gdk.Objects.Cursor.cursorNewFromName' are updated to reflect the theme
-- change. Custom cursors constructed with
-- 'GI.Gdk.Objects.Cursor.cursorNewFromTexture' will have to be handled
-- by the application (GTK+ applications can learn about
-- cursor theme changes by listening for change notification
-- for the corresponding @/GtkSetting/@).
x11DisplaySetCursorTheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> Maybe (T.Text)
    -- ^ /@theme@/: the name of the cursor theme to use, or 'P.Nothing' to unset
    --         a previously set value
    -> Int32
    -- ^ /@size@/: the cursor size to use, or 0 to keep the previous size
    -> m ()
x11DisplaySetCursorTheme :: a -> Maybe Text -> Int32 -> m ()
x11DisplaySetCursorTheme a
display Maybe Text
theme Int32
size = 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 X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    CString
maybeTheme <- case Maybe Text
theme of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jTheme -> do
            CString
jTheme' <- Text -> IO CString
textToCString Text
jTheme
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTheme'
    Ptr X11Display -> CString -> Int32 -> IO ()
gdk_x11_display_set_cursor_theme Ptr X11Display
display' CString
maybeTheme Int32
size
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTheme
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11DisplaySetCursorThemeMethodInfo
instance (signature ~ (Maybe (T.Text) -> Int32 -> m ()), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplaySetCursorThemeMethodInfo a signature where
    overloadedMethod = x11DisplaySetCursorTheme

#endif

-- method X11Display::set_startup_notification_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "startup_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the startup notification ID (must be valid utf8)"
--                 , 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_display_set_startup_notification_id" gdk_x11_display_set_startup_notification_id :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    CString ->                              -- startup_id : TBasicType TUTF8
    IO ()

-- | Sets the startup notification ID for a display.
-- 
-- This is usually taken from the value of the DESKTOP_STARTUP_ID
-- environment variable, but in some cases (such as the application not
-- being launched using @/exec()/@) it can come from other sources.
-- 
-- If the ID contains the string \"_TIME\" then the portion following that
-- string is taken to be the X11 timestamp of the event that triggered
-- the application to be launched and the GDK current event time is set
-- accordingly.
-- 
-- The startup ID is also what is used to signal that the startup is
-- complete (for example, when opening a window or when calling
-- @/gdk_notify_startup_complete()/@).
x11DisplaySetStartupNotificationId ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> T.Text
    -- ^ /@startupId@/: the startup notification ID (must be valid utf8)
    -> m ()
x11DisplaySetStartupNotificationId :: a -> Text -> m ()
x11DisplaySetStartupNotificationId a
display Text
startupId = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    CString
startupId' <- Text -> IO CString
textToCString Text
startupId
    Ptr X11Display -> CString -> IO ()
gdk_x11_display_set_startup_notification_id Ptr X11Display
display' CString
startupId'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
startupId'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11DisplaySetStartupNotificationIdMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplaySetStartupNotificationIdMethodInfo a signature where
    overloadedMethod = x11DisplaySetStartupNotificationId

#endif

-- method X11Display::set_surface_scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the display" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scale"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new scale value"
--                 , 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_display_set_surface_scale" gdk_x11_display_set_surface_scale :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    Int32 ->                                -- scale : TBasicType TInt
    IO ()

-- | Forces a specific window scale for all windows on this display,
-- instead of using the default or user configured scale. This
-- is can be used to disable scaling support by setting /@scale@/ to
-- 1, or to programmatically set the window scale.
-- 
-- Once the scale is set by this call it will not change in response
-- to later user configuration changes.
x11DisplaySetSurfaceScale ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: the display
    -> Int32
    -- ^ /@scale@/: The new scale value
    -> m ()
x11DisplaySetSurfaceScale :: a -> Int32 -> m ()
x11DisplaySetSurfaceScale a
display Int32
scale = 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 X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr X11Display -> Int32 -> IO ()
gdk_x11_display_set_surface_scale Ptr X11Display
display' Int32
scale
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11DisplaySetSurfaceScaleMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplaySetSurfaceScaleMethodInfo a signature where
    overloadedMethod = x11DisplaySetSurfaceScale

#endif

-- method X11Display::string_to_compound_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkDisplay where the encoding is defined"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a nul-terminated string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "encoding"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the encoding\n    (to be used as the type for the property)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the format of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "ctext"
--           , argType = TCArray False (-1) 5 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location to store newly\n    allocated data for the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @ctext, in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of @ctext, in bytes"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_display_string_to_compound_text" gdk_x11_display_string_to_compound_text :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    CString ->                              -- str : TBasicType TUTF8
    Ptr CString ->                          -- encoding : TBasicType TUTF8
    Ptr Int32 ->                            -- format : TBasicType TInt
    Ptr (Ptr Word8) ->                      -- ctext : TCArray False (-1) 5 (TBasicType TUInt8)
    Ptr Int32 ->                            -- length : TBasicType TInt
    IO Int32

-- | Convert a string from the encoding of the current
-- locale into a form suitable for storing in a window property.
x11DisplayStringToCompoundText ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: the t'GI.Gdk.Objects.Display.Display' where the encoding is defined
    -> T.Text
    -- ^ /@str@/: a nul-terminated string
    -> m ((Int32, T.Text, Int32, ByteString))
    -- ^ __Returns:__ 0 upon success, non-zero upon failure
x11DisplayStringToCompoundText :: a -> Text -> m (Int32, Text, Int32, ByteString)
x11DisplayStringToCompoundText a
display Text
str = IO (Int32, Text, Int32, ByteString)
-> m (Int32, Text, Int32, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Text, Int32, ByteString)
 -> m (Int32, Text, Int32, ByteString))
-> IO (Int32, Text, Int32, ByteString)
-> m (Int32, Text, Int32, ByteString)
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
    CString
str' <- Text -> IO CString
textToCString Text
str
    Ptr CString
encoding <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Int32
format <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr (Ptr Word8)
ctext <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Word8))
    Ptr Int32
length_ <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Int32
result <- Ptr X11Display
-> CString
-> Ptr CString
-> Ptr Int32
-> Ptr (Ptr Word8)
-> Ptr Int32
-> IO Int32
gdk_x11_display_string_to_compound_text Ptr X11Display
display' CString
str' Ptr CString
encoding Ptr Int32
format Ptr (Ptr Word8)
ctext Ptr Int32
length_
    Int32
length_' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
length_
    CString
encoding' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
encoding
    Text
encoding'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
encoding'
    Int32
format' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
format
    Ptr Word8
ctext' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
ctext
    ByteString
ctext'' <- (Int32 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Int32
length_') Ptr Word8
ctext'
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
ctext'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
encoding
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
format
    Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
ctext
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
length_
    (Int32, Text, Int32, ByteString)
-> IO (Int32, Text, Int32, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Text
encoding'', Int32
format', ByteString
ctext'')

#if defined(ENABLE_OVERLOADING)
data X11DisplayStringToCompoundTextMethodInfo
instance (signature ~ (T.Text -> m ((Int32, T.Text, Int32, ByteString))), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayStringToCompoundTextMethodInfo a signature where
    overloadedMethod = x11DisplayStringToCompoundText

#endif

-- method X11Display::text_property_to_text_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GdkDisplay where the encoding is defined"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "encoding"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a string representing the encoding. The most\n   common values for this are \"STRING\", or \"COMPOUND_TEXT\".\n   This is value used as the type for the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The text data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of items to transform"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "list"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store an  array of strings in\n   the encoding of the current locale. This array should be\n   freed using gdk_free_text_list()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_display_text_property_to_text_list" gdk_x11_display_text_property_to_text_list :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    CString ->                              -- encoding : TBasicType TUTF8
    Int32 ->                                -- format : TBasicType TInt
    Word8 ->                                -- text : TBasicType TUInt8
    Int32 ->                                -- length : TBasicType TInt
    CString ->                              -- list : TBasicType TUTF8
    IO Int32

-- | Convert a text string from the encoding as it is stored
-- in a property into an array of strings in the encoding of
-- the current locale. (The elements of the array represent the
-- nul-separated elements of the original text string.)
x11DisplayTextPropertyToTextList ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: The t'GI.Gdk.Objects.Display.Display' where the encoding is defined
    -> T.Text
    -- ^ /@encoding@/: a string representing the encoding. The most
    --    common values for this are \"STRING\", or \"COMPOUND_TEXT\".
    --    This is value used as the type for the property
    -> Int32
    -- ^ /@format@/: the format of the property
    -> Word8
    -- ^ /@text@/: The text data
    -> Int32
    -- ^ /@length@/: The number of items to transform
    -> T.Text
    -- ^ /@list@/: location to store an  array of strings in
    --    the encoding of the current locale. This array should be
    --    freed using @/gdk_free_text_list()/@.
    -> m Int32
    -- ^ __Returns:__ the number of strings stored in list, or 0,
    --     if the conversion failed
x11DisplayTextPropertyToTextList :: a -> Text -> Int32 -> Word8 -> Int32 -> Text -> m Int32
x11DisplayTextPropertyToTextList a
display Text
encoding Int32
format Word8
text Int32
length_ Text
list = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    CString
encoding' <- Text -> IO CString
textToCString Text
encoding
    CString
list' <- Text -> IO CString
textToCString Text
list
    Int32
result <- Ptr X11Display
-> CString -> Int32 -> Word8 -> Int32 -> CString -> IO Int32
gdk_x11_display_text_property_to_text_list Ptr X11Display
display' CString
encoding' Int32
format Word8
text Int32
length_ CString
list'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
encoding'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
list'
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data X11DisplayTextPropertyToTextListMethodInfo
instance (signature ~ (T.Text -> Int32 -> Word8 -> Int32 -> T.Text -> m Int32), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayTextPropertyToTextListMethodInfo a signature where
    overloadedMethod = x11DisplayTextPropertyToTextList

#endif

-- method X11Display::ungrab
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , 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_display_ungrab" gdk_x11_display_ungrab :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    IO ()

-- | Ungrab /@display@/ after it has been grabbed with
-- 'GI.GdkX11.Objects.X11Display.x11DisplayGrab'.
x11DisplayUngrab ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m ()
x11DisplayUngrab :: a -> m ()
x11DisplayUngrab a
display = 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 X11Display
display' <- a -> IO (Ptr X11Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr X11Display -> IO ()
gdk_x11_display_ungrab Ptr X11Display
display'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data X11DisplayUngrabMethodInfo
instance (signature ~ (m ()), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayUngrabMethodInfo a signature where
    overloadedMethod = x11DisplayUngrab

#endif

-- method X11Display::utf8_to_compound_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "GdkX11" , name = "X11Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a UTF-8 string" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "encoding"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store resulting encoding"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store format of the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "ctext"
--           , argType = TCArray False (-1) 5 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the data of the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the length of the data\n    stored in @ctext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "location to store the length of the data\n    stored in @ctext"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_display_utf8_to_compound_text" gdk_x11_display_utf8_to_compound_text :: 
    Ptr X11Display ->                       -- display : TInterface (Name {namespace = "GdkX11", name = "X11Display"})
    CString ->                              -- str : TBasicType TUTF8
    Ptr CString ->                          -- encoding : TBasicType TUTF8
    Ptr Int32 ->                            -- format : TBasicType TInt
    Ptr (Ptr Word8) ->                      -- ctext : TCArray False (-1) 5 (TBasicType TUInt8)
    Ptr Int32 ->                            -- length : TBasicType TInt
    IO CInt

-- | Converts from UTF-8 to compound text.
x11DisplayUtf8ToCompoundText ::
    (B.CallStack.HasCallStack, MonadIO m, IsX11Display a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> T.Text
    -- ^ /@str@/: a UTF-8 string
    -> m ((Bool, T.Text, Int32, ByteString))
    -- ^ __Returns:__ 'P.True' if the conversion succeeded,
    --     otherwise 'P.False'
x11DisplayUtf8ToCompoundText :: a -> Text -> m (Bool, Text, Int32, ByteString)
x11DisplayUtf8ToCompoundText a
display Text
str = IO (Bool, Text, Int32, ByteString)
-> m (Bool, Text, Int32, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text, Int32, ByteString)
 -> m (Bool, Text, Int32, ByteString))
-> IO (Bool, Text, Int32, ByteString)
-> m (Bool, Text, Int32, ByteString)
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
    CString
str' <- Text -> IO CString
textToCString Text
str
    Ptr CString
encoding <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Int32
format <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr (Ptr Word8)
ctext <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Word8))
    Ptr Int32
length_ <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr X11Display
-> CString
-> Ptr CString
-> Ptr Int32
-> Ptr (Ptr Word8)
-> Ptr Int32
-> IO CInt
gdk_x11_display_utf8_to_compound_text Ptr X11Display
display' CString
str' Ptr CString
encoding Ptr Int32
format Ptr (Ptr Word8)
ctext Ptr Int32
length_
    Int32
length_' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
length_
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString
encoding' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
encoding
    Text
encoding'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
encoding'
    Int32
format' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
format
    Ptr Word8
ctext' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
ctext
    ByteString
ctext'' <- (Int32 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Int32
length_') Ptr Word8
ctext'
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
ctext'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
encoding
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
format
    Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
ctext
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
length_
    (Bool, Text, Int32, ByteString)
-> IO (Bool, Text, Int32, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
encoding'', Int32
format', ByteString
ctext'')

#if defined(ENABLE_OVERLOADING)
data X11DisplayUtf8ToCompoundTextMethodInfo
instance (signature ~ (T.Text -> m ((Bool, T.Text, Int32, ByteString))), MonadIO m, IsX11Display a) => O.MethodInfo X11DisplayUtf8ToCompoundTextMethodInfo a signature where
    overloadedMethod = x11DisplayUtf8ToCompoundText

#endif

-- method X11Display::get_glx_version
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "major"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the GLX major version"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "minor"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the GLX minor version"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_display_get_glx_version" gdk_x11_display_get_glx_version :: 
    Ptr Gdk.Display.Display ->              -- display : TInterface (Name {namespace = "Gdk", name = "Display"})
    Ptr Int32 ->                            -- major : TBasicType TInt
    Ptr Int32 ->                            -- minor : TBasicType TInt
    IO CInt

-- | Retrieves the version of the GLX implementation.
x11DisplayGetGlxVersion ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Display.IsDisplay a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m ((Bool, Int32, Int32))
    -- ^ __Returns:__ 'P.True' if GLX is available
x11DisplayGetGlxVersion :: a -> m (Bool, Int32, Int32)
x11DisplayGetGlxVersion a
display = IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32))
-> IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Display
display' <- a -> IO (Ptr Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr Int32
major <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
minor <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr Display -> Ptr Int32 -> Ptr Int32 -> IO CInt
gdk_x11_display_get_glx_version Ptr Display
display' Ptr Int32
major Ptr Int32
minor
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
major' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
major
    Int32
minor' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
minor
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
major
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
minor
    (Bool, Int32, Int32) -> IO (Bool, Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
major', Int32
minor')

#if defined(ENABLE_OVERLOADING)
#endif

-- method X11Display::get_primary_monitor
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Monitor" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_display_get_primary_monitor" gdk_x11_display_get_primary_monitor :: 
    Ptr Gdk.Display.Display ->              -- self : TInterface (Name {namespace = "Gdk", name = "Display"})
    IO (Ptr Gdk.Monitor.Monitor)

-- | Gets the primary monitor for the display.
-- 
-- The primary monitor is considered the monitor where the “main desktop”
-- lives. While normal application surfaces typically allow the window
-- manager to place the surfaces, specialized desktop applications
-- such as panels should place themselves on the primary monitor.
-- 
-- If no monitor is the designated primary monitor, any monitor
-- (usually the first) may be returned.
x11DisplayGetPrimaryMonitor ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Display.IsDisplay a) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Display.Display'
    -> m Gdk.Monitor.Monitor
    -- ^ __Returns:__ the primary monitor, or any monitor if no
    --     primary monitor is configured by the user
x11DisplayGetPrimaryMonitor :: a -> m Monitor
x11DisplayGetPrimaryMonitor a
self = IO Monitor -> m Monitor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Monitor -> m Monitor) -> IO Monitor -> m Monitor
forall a b. (a -> b) -> a -> b
$ do
    Ptr Display
self' <- a -> IO (Ptr Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Monitor
result <- Ptr Display -> IO (Ptr Monitor)
gdk_x11_display_get_primary_monitor Ptr Display
self'
    Text -> Ptr Monitor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"x11DisplayGetPrimaryMonitor" Ptr Monitor
result
    Monitor
result' <- ((ManagedPtr Monitor -> Monitor) -> Ptr Monitor -> IO Monitor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Monitor -> Monitor
Gdk.Monitor.Monitor) Ptr Monitor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Monitor -> IO Monitor
forall (m :: * -> *) a. Monad m => a -> m a
return Monitor
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method X11Display::get_screen
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkX11Display" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkX11" , name = "X11Screen" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_display_get_screen" gdk_x11_display_get_screen :: 
    Ptr Gdk.Display.Display ->              -- display : TInterface (Name {namespace = "Gdk", name = "Display"})
    IO (Ptr GdkX11.X11Screen.X11Screen)

-- | Retrieves the t'GI.GdkX11.Objects.X11Screen.X11Screen' of the /@display@/.
x11DisplayGetScreen ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Display.IsDisplay a) =>
    a
    -- ^ /@display@/: a t'GI.GdkX11.Objects.X11Display.X11Display'
    -> m GdkX11.X11Screen.X11Screen
    -- ^ __Returns:__ the t'GI.GdkX11.Objects.X11Screen.X11Screen'
x11DisplayGetScreen :: a -> m X11Screen
x11DisplayGetScreen a
display = IO X11Screen -> m X11Screen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO X11Screen -> m X11Screen) -> IO X11Screen -> m X11Screen
forall a b. (a -> b) -> a -> b
$ do
    Ptr Display
display' <- a -> IO (Ptr Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr X11Screen
result <- Ptr Display -> IO (Ptr X11Screen)
gdk_x11_display_get_screen Ptr Display
display'
    Text -> Ptr X11Screen -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"x11DisplayGetScreen" Ptr X11Screen
result
    X11Screen
result' <- ((ManagedPtr X11Screen -> X11Screen)
-> Ptr X11Screen -> IO X11Screen
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr X11Screen -> X11Screen
GdkX11.X11Screen.X11Screen) Ptr X11Screen
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    X11Screen -> IO X11Screen
forall (m :: * -> *) a. Monad m => a -> m a
return X11Screen
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method X11Display::open
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "display_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "name of the X display.\n    See the XOpenDisplay() for details."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Display" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_x11_display_open" gdk_x11_display_open :: 
    CString ->                              -- display_name : TBasicType TUTF8
    IO (Ptr Gdk.Display.Display)

-- | Tries to open a new display to the X server given by
-- /@displayName@/. If opening the display fails, 'P.Nothing' is
-- returned.
x11DisplayOpen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@displayName@/: name of the X display.
    --     See the 'GI.Xlib.Functions.openDisplay' for details.
    -> m (Maybe Gdk.Display.Display)
    -- ^ __Returns:__ The new display or
    --     'P.Nothing' on error.
x11DisplayOpen :: Maybe Text -> m (Maybe Display)
x11DisplayOpen Maybe Text
displayName = IO (Maybe Display) -> m (Maybe Display)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Display) -> m (Maybe Display))
-> IO (Maybe Display) -> m (Maybe Display)
forall a b. (a -> b) -> a -> b
$ do
    CString
maybeDisplayName <- case Maybe Text
displayName of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jDisplayName -> do
            CString
jDisplayName' <- Text -> IO CString
textToCString Text
jDisplayName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jDisplayName'
    Ptr Display
result <- CString -> IO (Ptr Display)
gdk_x11_display_open CString
maybeDisplayName
    Maybe Display
maybeResult <- Ptr Display -> (Ptr Display -> IO Display) -> IO (Maybe Display)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Display
result ((Ptr Display -> IO Display) -> IO (Maybe Display))
-> (Ptr Display -> IO Display) -> IO (Maybe Display)
forall a b. (a -> b) -> a -> b
$ \Ptr Display
result' -> do
        Display
result'' <- ((ManagedPtr Display -> Display) -> Ptr Display -> IO Display
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Display -> Display
Gdk.Display.Display) Ptr Display
result'
        Display -> IO Display
forall (m :: * -> *) a. Monad m => a -> m a
return Display
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeDisplayName
    Maybe Display -> IO (Maybe Display)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Display
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method X11Display::set_program_class
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "program_class"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string" , 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_display_set_program_class" gdk_x11_display_set_program_class :: 
    Ptr Gdk.Display.Display ->              -- display : TInterface (Name {namespace = "Gdk", name = "Display"})
    CString ->                              -- program_class : TBasicType TUTF8
    IO ()

-- | Sets the program class.
-- 
-- The X11 backend uses the program class to set the class name part
-- of the @WM_CLASS@ property on toplevel windows; see the ICCCM.
x11DisplaySetProgramClass ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Display.IsDisplay a) =>
    a
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> T.Text
    -- ^ /@programClass@/: a string
    -> m ()
x11DisplaySetProgramClass :: a -> Text -> m ()
x11DisplaySetProgramClass a
display Text
programClass = 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 Display
display' <- a -> IO (Ptr Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    CString
programClass' <- Text -> IO CString
textToCString Text
programClass
    Ptr Display -> CString -> IO ()
gdk_x11_display_set_program_class Ptr Display
display' CString
programClass'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
programClass'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif