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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Wnck.Objects.Screen.Screen' struct contains only private fields and should not be
-- directly accessed.

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

module GI.Wnck.Objects.Screen
    ( 

-- * Exported types
    Screen(..)                              ,
    IsScreen                                ,
    toScreen                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [calcWorkspaceLayout]("GI.Wnck.Objects.Screen#g:method:calcWorkspaceLayout"), [changeWorkspaceCount]("GI.Wnck.Objects.Screen#g:method:changeWorkspaceCount"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [forceUpdate]("GI.Wnck.Objects.Screen#g:method:forceUpdate"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [moveViewport]("GI.Wnck.Objects.Screen#g:method:moveViewport"), [netWmSupports]("GI.Wnck.Objects.Screen#g:method:netWmSupports"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [releaseWorkspaceLayout]("GI.Wnck.Objects.Screen#g:method:releaseWorkspaceLayout"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [toggleShowingDesktop]("GI.Wnck.Objects.Screen#g:method:toggleShowingDesktop"), [trySetWorkspaceLayout]("GI.Wnck.Objects.Screen#g:method:trySetWorkspaceLayout"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getActiveWindow]("GI.Wnck.Objects.Screen#g:method:getActiveWindow"), [getActiveWorkspace]("GI.Wnck.Objects.Screen#g:method:getActiveWorkspace"), [getBackgroundPixmap]("GI.Wnck.Objects.Screen#g:method:getBackgroundPixmap"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getHeight]("GI.Wnck.Objects.Screen#g:method:getHeight"), [getNumber]("GI.Wnck.Objects.Screen#g:method:getNumber"), [getPreviouslyActiveWindow]("GI.Wnck.Objects.Screen#g:method:getPreviouslyActiveWindow"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getShowingDesktop]("GI.Wnck.Objects.Screen#g:method:getShowingDesktop"), [getWidth]("GI.Wnck.Objects.Screen#g:method:getWidth"), [getWindowManagerName]("GI.Wnck.Objects.Screen#g:method:getWindowManagerName"), [getWindows]("GI.Wnck.Objects.Screen#g:method:getWindows"), [getWindowsStacked]("GI.Wnck.Objects.Screen#g:method:getWindowsStacked"), [getWorkspace]("GI.Wnck.Objects.Screen#g:method:getWorkspace"), [getWorkspaceCount]("GI.Wnck.Objects.Screen#g:method:getWorkspaceCount"), [getWorkspaces]("GI.Wnck.Objects.Screen#g:method:getWorkspaces").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveScreenMethod                     ,
#endif

-- ** calcWorkspaceLayout #method:calcWorkspaceLayout#

#if defined(ENABLE_OVERLOADING)
    ScreenCalcWorkspaceLayoutMethodInfo     ,
#endif
    screenCalcWorkspaceLayout               ,


-- ** changeWorkspaceCount #method:changeWorkspaceCount#

#if defined(ENABLE_OVERLOADING)
    ScreenChangeWorkspaceCountMethodInfo    ,
#endif
    screenChangeWorkspaceCount              ,


-- ** forceUpdate #method:forceUpdate#

#if defined(ENABLE_OVERLOADING)
    ScreenForceUpdateMethodInfo             ,
#endif
    screenForceUpdate                       ,


-- ** freeWorkspaceLayout #method:freeWorkspaceLayout#

    screenFreeWorkspaceLayout               ,


-- ** get #method:get#

    screenGet                               ,


-- ** getActiveWindow #method:getActiveWindow#

#if defined(ENABLE_OVERLOADING)
    ScreenGetActiveWindowMethodInfo         ,
#endif
    screenGetActiveWindow                   ,


-- ** getActiveWorkspace #method:getActiveWorkspace#

#if defined(ENABLE_OVERLOADING)
    ScreenGetActiveWorkspaceMethodInfo      ,
#endif
    screenGetActiveWorkspace                ,


-- ** getBackgroundPixmap #method:getBackgroundPixmap#

#if defined(ENABLE_OVERLOADING)
    ScreenGetBackgroundPixmapMethodInfo     ,
#endif
    screenGetBackgroundPixmap               ,


-- ** getDefault #method:getDefault#

    screenGetDefault                        ,


-- ** getForRoot #method:getForRoot#

    screenGetForRoot                        ,


-- ** getHeight #method:getHeight#

#if defined(ENABLE_OVERLOADING)
    ScreenGetHeightMethodInfo               ,
#endif
    screenGetHeight                         ,


-- ** getNumber #method:getNumber#

#if defined(ENABLE_OVERLOADING)
    ScreenGetNumberMethodInfo               ,
#endif
    screenGetNumber                         ,


-- ** getPreviouslyActiveWindow #method:getPreviouslyActiveWindow#

#if defined(ENABLE_OVERLOADING)
    ScreenGetPreviouslyActiveWindowMethodInfo,
#endif
    screenGetPreviouslyActiveWindow         ,


-- ** getShowingDesktop #method:getShowingDesktop#

#if defined(ENABLE_OVERLOADING)
    ScreenGetShowingDesktopMethodInfo       ,
#endif
    screenGetShowingDesktop                 ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    ScreenGetWidthMethodInfo                ,
#endif
    screenGetWidth                          ,


-- ** getWindowManagerName #method:getWindowManagerName#

#if defined(ENABLE_OVERLOADING)
    ScreenGetWindowManagerNameMethodInfo    ,
#endif
    screenGetWindowManagerName              ,


-- ** getWindows #method:getWindows#

#if defined(ENABLE_OVERLOADING)
    ScreenGetWindowsMethodInfo              ,
#endif
    screenGetWindows                        ,


-- ** getWindowsStacked #method:getWindowsStacked#

#if defined(ENABLE_OVERLOADING)
    ScreenGetWindowsStackedMethodInfo       ,
#endif
    screenGetWindowsStacked                 ,


-- ** getWorkspace #method:getWorkspace#

#if defined(ENABLE_OVERLOADING)
    ScreenGetWorkspaceMethodInfo            ,
#endif
    screenGetWorkspace                      ,


-- ** getWorkspaceCount #method:getWorkspaceCount#

#if defined(ENABLE_OVERLOADING)
    ScreenGetWorkspaceCountMethodInfo       ,
#endif
    screenGetWorkspaceCount                 ,


-- ** getWorkspaces #method:getWorkspaces#

#if defined(ENABLE_OVERLOADING)
    ScreenGetWorkspacesMethodInfo           ,
#endif
    screenGetWorkspaces                     ,


-- ** moveViewport #method:moveViewport#

#if defined(ENABLE_OVERLOADING)
    ScreenMoveViewportMethodInfo            ,
#endif
    screenMoveViewport                      ,


-- ** netWmSupports #method:netWmSupports#

#if defined(ENABLE_OVERLOADING)
    ScreenNetWmSupportsMethodInfo           ,
#endif
    screenNetWmSupports                     ,


-- ** releaseWorkspaceLayout #method:releaseWorkspaceLayout#

#if defined(ENABLE_OVERLOADING)
    ScreenReleaseWorkspaceLayoutMethodInfo  ,
#endif
    screenReleaseWorkspaceLayout            ,


-- ** toggleShowingDesktop #method:toggleShowingDesktop#

#if defined(ENABLE_OVERLOADING)
    ScreenToggleShowingDesktopMethodInfo    ,
#endif
    screenToggleShowingDesktop              ,


-- ** trySetWorkspaceLayout #method:trySetWorkspaceLayout#

#if defined(ENABLE_OVERLOADING)
    ScreenTrySetWorkspaceLayoutMethodInfo   ,
#endif
    screenTrySetWorkspaceLayout             ,




 -- * Signals


-- ** activeWindowChanged #signal:activeWindowChanged#

    ScreenActiveWindowChangedCallback       ,
#if defined(ENABLE_OVERLOADING)
    ScreenActiveWindowChangedSignalInfo     ,
#endif
    afterScreenActiveWindowChanged          ,
    onScreenActiveWindowChanged             ,


-- ** activeWorkspaceChanged #signal:activeWorkspaceChanged#

    ScreenActiveWorkspaceChangedCallback    ,
#if defined(ENABLE_OVERLOADING)
    ScreenActiveWorkspaceChangedSignalInfo  ,
#endif
    afterScreenActiveWorkspaceChanged       ,
    onScreenActiveWorkspaceChanged          ,


-- ** applicationClosed #signal:applicationClosed#

    ScreenApplicationClosedCallback         ,
#if defined(ENABLE_OVERLOADING)
    ScreenApplicationClosedSignalInfo       ,
#endif
    afterScreenApplicationClosed            ,
    onScreenApplicationClosed               ,


-- ** applicationOpened #signal:applicationOpened#

    ScreenApplicationOpenedCallback         ,
#if defined(ENABLE_OVERLOADING)
    ScreenApplicationOpenedSignalInfo       ,
#endif
    afterScreenApplicationOpened            ,
    onScreenApplicationOpened               ,


-- ** backgroundChanged #signal:backgroundChanged#

    ScreenBackgroundChangedCallback         ,
#if defined(ENABLE_OVERLOADING)
    ScreenBackgroundChangedSignalInfo       ,
#endif
    afterScreenBackgroundChanged            ,
    onScreenBackgroundChanged               ,


-- ** classGroupClosed #signal:classGroupClosed#

    ScreenClassGroupClosedCallback          ,
#if defined(ENABLE_OVERLOADING)
    ScreenClassGroupClosedSignalInfo        ,
#endif
    afterScreenClassGroupClosed             ,
    onScreenClassGroupClosed                ,


-- ** classGroupOpened #signal:classGroupOpened#

    ScreenClassGroupOpenedCallback          ,
#if defined(ENABLE_OVERLOADING)
    ScreenClassGroupOpenedSignalInfo        ,
#endif
    afterScreenClassGroupOpened             ,
    onScreenClassGroupOpened                ,


-- ** showingDesktopChanged #signal:showingDesktopChanged#

    ScreenShowingDesktopChangedCallback     ,
#if defined(ENABLE_OVERLOADING)
    ScreenShowingDesktopChangedSignalInfo   ,
#endif
    afterScreenShowingDesktopChanged        ,
    onScreenShowingDesktopChanged           ,


-- ** viewportsChanged #signal:viewportsChanged#

    ScreenViewportsChangedCallback          ,
#if defined(ENABLE_OVERLOADING)
    ScreenViewportsChangedSignalInfo        ,
#endif
    afterScreenViewportsChanged             ,
    onScreenViewportsChanged                ,


-- ** windowClosed #signal:windowClosed#

    ScreenWindowClosedCallback              ,
#if defined(ENABLE_OVERLOADING)
    ScreenWindowClosedSignalInfo            ,
#endif
    afterScreenWindowClosed                 ,
    onScreenWindowClosed                    ,


-- ** windowManagerChanged #signal:windowManagerChanged#

    ScreenWindowManagerChangedCallback      ,
#if defined(ENABLE_OVERLOADING)
    ScreenWindowManagerChangedSignalInfo    ,
#endif
    afterScreenWindowManagerChanged         ,
    onScreenWindowManagerChanged            ,


-- ** windowOpened #signal:windowOpened#

    ScreenWindowOpenedCallback              ,
#if defined(ENABLE_OVERLOADING)
    ScreenWindowOpenedSignalInfo            ,
#endif
    afterScreenWindowOpened                 ,
    onScreenWindowOpened                    ,


-- ** windowStackingChanged #signal:windowStackingChanged#

    ScreenWindowStackingChangedCallback     ,
#if defined(ENABLE_OVERLOADING)
    ScreenWindowStackingChangedSignalInfo   ,
#endif
    afterScreenWindowStackingChanged        ,
    onScreenWindowStackingChanged           ,


-- ** workspaceCreated #signal:workspaceCreated#

    ScreenWorkspaceCreatedCallback          ,
#if defined(ENABLE_OVERLOADING)
    ScreenWorkspaceCreatedSignalInfo        ,
#endif
    afterScreenWorkspaceCreated             ,
    onScreenWorkspaceCreated                ,


-- ** workspaceDestroyed #signal:workspaceDestroyed#

    ScreenWorkspaceDestroyedCallback        ,
#if defined(ENABLE_OVERLOADING)
    ScreenWorkspaceDestroyedSignalInfo      ,
#endif
    afterScreenWorkspaceDestroyed           ,
    onScreenWorkspaceDestroyed              ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Wnck.Objects.Application as Wnck.Application
import {-# SOURCE #-} qualified GI.Wnck.Objects.ClassGroup as Wnck.ClassGroup
import {-# SOURCE #-} qualified GI.Wnck.Objects.Window as Wnck.Window
import {-# SOURCE #-} qualified GI.Wnck.Objects.Workspace as Wnck.Workspace
import {-# SOURCE #-} qualified GI.Wnck.Structs.WorkspaceLayout as Wnck.WorkspaceLayout

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

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

foreign import ccall "wnck_screen_get_type"
    c_wnck_screen_get_type :: IO B.Types.GType

instance B.Types.TypedObject Screen where
    glibType :: IO GType
glibType = IO GType
c_wnck_screen_get_type

instance B.Types.GObject Screen

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

instance O.HasParentTypes Screen
type instance O.ParentTypes Screen = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveScreenMethod (t :: Symbol) (o :: *) :: * where
    ResolveScreenMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveScreenMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveScreenMethod "calcWorkspaceLayout" o = ScreenCalcWorkspaceLayoutMethodInfo
    ResolveScreenMethod "changeWorkspaceCount" o = ScreenChangeWorkspaceCountMethodInfo
    ResolveScreenMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveScreenMethod "forceUpdate" o = ScreenForceUpdateMethodInfo
    ResolveScreenMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveScreenMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveScreenMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveScreenMethod "moveViewport" o = ScreenMoveViewportMethodInfo
    ResolveScreenMethod "netWmSupports" o = ScreenNetWmSupportsMethodInfo
    ResolveScreenMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveScreenMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveScreenMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveScreenMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveScreenMethod "releaseWorkspaceLayout" o = ScreenReleaseWorkspaceLayoutMethodInfo
    ResolveScreenMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveScreenMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveScreenMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveScreenMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveScreenMethod "toggleShowingDesktop" o = ScreenToggleShowingDesktopMethodInfo
    ResolveScreenMethod "trySetWorkspaceLayout" o = ScreenTrySetWorkspaceLayoutMethodInfo
    ResolveScreenMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveScreenMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveScreenMethod "getActiveWindow" o = ScreenGetActiveWindowMethodInfo
    ResolveScreenMethod "getActiveWorkspace" o = ScreenGetActiveWorkspaceMethodInfo
    ResolveScreenMethod "getBackgroundPixmap" o = ScreenGetBackgroundPixmapMethodInfo
    ResolveScreenMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveScreenMethod "getHeight" o = ScreenGetHeightMethodInfo
    ResolveScreenMethod "getNumber" o = ScreenGetNumberMethodInfo
    ResolveScreenMethod "getPreviouslyActiveWindow" o = ScreenGetPreviouslyActiveWindowMethodInfo
    ResolveScreenMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveScreenMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveScreenMethod "getShowingDesktop" o = ScreenGetShowingDesktopMethodInfo
    ResolveScreenMethod "getWidth" o = ScreenGetWidthMethodInfo
    ResolveScreenMethod "getWindowManagerName" o = ScreenGetWindowManagerNameMethodInfo
    ResolveScreenMethod "getWindows" o = ScreenGetWindowsMethodInfo
    ResolveScreenMethod "getWindowsStacked" o = ScreenGetWindowsStackedMethodInfo
    ResolveScreenMethod "getWorkspace" o = ScreenGetWorkspaceMethodInfo
    ResolveScreenMethod "getWorkspaceCount" o = ScreenGetWorkspaceCountMethodInfo
    ResolveScreenMethod "getWorkspaces" o = ScreenGetWorkspacesMethodInfo
    ResolveScreenMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveScreenMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveScreenMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveScreenMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif

-- signal Screen::active-window-changed
-- | Emitted when the active window on /@screen@/ has changed.
type ScreenActiveWindowChangedCallback =
    Wnck.Window.Window
    -- ^ /@previouslyActiveWindow@/: the previously active t'GI.Wnck.Objects.Window.Window' before this
    -- change.
    -> IO ()

type C_ScreenActiveWindowChangedCallback =
    Ptr Screen ->                           -- object
    Ptr Wnck.Window.Window ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenActiveWindowChangedCallback :: 
    GObject a => (a -> ScreenActiveWindowChangedCallback) ->
    C_ScreenActiveWindowChangedCallback
wrap_ScreenActiveWindowChangedCallback :: forall a.
GObject a =>
(a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
wrap_ScreenActiveWindowChangedCallback a -> ScreenActiveWindowChangedCallback
gi'cb Ptr Screen
gi'selfPtr Ptr Window
previouslyActiveWindow Ptr ()
_ = do
    Window
previouslyActiveWindow' <- ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Wnck.Window.Window) Ptr Window
previouslyActiveWindow
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> ScreenActiveWindowChangedCallback
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self)  Window
previouslyActiveWindow'


-- | Connect a signal handler for the [activeWindowChanged](#signal:activeWindowChanged) 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' screen #activeWindowChanged callback
-- @
-- 
-- 
onScreenActiveWindowChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenActiveWindowChangedCallback) -> m SignalHandlerId
onScreenActiveWindowChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWindowChangedCallback)
-> m SignalHandlerId
onScreenActiveWindowChanged a
obj (?self::a) => ScreenActiveWindowChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWindowChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWindowChangedCallback
ScreenActiveWindowChangedCallback
cb
    let wrapped' :: C_ScreenActiveWindowChangedCallback
wrapped' = (a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
wrap_ScreenActiveWindowChangedCallback a -> ScreenActiveWindowChangedCallback
wrapped
    FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' <- C_ScreenActiveWindowChangedCallback
-> IO (FunPtr C_ScreenActiveWindowChangedCallback)
mk_ScreenActiveWindowChangedCallback C_ScreenActiveWindowChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWindowChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"active-window-changed" FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [activeWindowChanged](#signal:activeWindowChanged) 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' screen #activeWindowChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenActiveWindowChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenActiveWindowChangedCallback) -> m SignalHandlerId
afterScreenActiveWindowChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWindowChangedCallback)
-> m SignalHandlerId
afterScreenActiveWindowChanged a
obj (?self::a) => ScreenActiveWindowChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWindowChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWindowChangedCallback
ScreenActiveWindowChangedCallback
cb
    let wrapped' :: C_ScreenActiveWindowChangedCallback
wrapped' = (a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
wrap_ScreenActiveWindowChangedCallback a -> ScreenActiveWindowChangedCallback
wrapped
    FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' <- C_ScreenActiveWindowChangedCallback
-> IO (FunPtr C_ScreenActiveWindowChangedCallback)
mk_ScreenActiveWindowChangedCallback C_ScreenActiveWindowChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWindowChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"active-window-changed" FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenActiveWindowChangedSignalInfo
instance SignalInfo ScreenActiveWindowChangedSignalInfo where
    type HaskellCallbackType ScreenActiveWindowChangedSignalInfo = ScreenActiveWindowChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenActiveWindowChangedCallback cb
        cb'' <- mk_ScreenActiveWindowChangedCallback cb'
        connectSignalFunPtr obj "active-window-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::active-window-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:activeWindowChanged"})

#endif

-- signal Screen::active-workspace-changed
-- | Emitted when the active workspace on /@screen@/ has changed.
type ScreenActiveWorkspaceChangedCallback =
    Wnck.Workspace.Workspace
    -- ^ /@previouslyActiveSpace@/: the previously active t'GI.Wnck.Objects.Workspace.Workspace' before this
    -- change.
    -> IO ()

type C_ScreenActiveWorkspaceChangedCallback =
    Ptr Screen ->                           -- object
    Ptr Wnck.Workspace.Workspace ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenActiveWorkspaceChangedCallback :: 
    GObject a => (a -> ScreenActiveWorkspaceChangedCallback) ->
    C_ScreenActiveWorkspaceChangedCallback
wrap_ScreenActiveWorkspaceChangedCallback :: forall a.
GObject a =>
(a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
wrap_ScreenActiveWorkspaceChangedCallback a -> ScreenActiveWorkspaceChangedCallback
gi'cb Ptr Screen
gi'selfPtr Ptr Workspace
previouslyActiveSpace Ptr ()
_ = do
    Workspace
previouslyActiveSpace' <- ((ManagedPtr Workspace -> Workspace)
-> Ptr Workspace -> IO Workspace
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Workspace -> Workspace
Wnck.Workspace.Workspace) Ptr Workspace
previouslyActiveSpace
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> ScreenActiveWorkspaceChangedCallback
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self)  Workspace
previouslyActiveSpace'


-- | Connect a signal handler for the [activeWorkspaceChanged](#signal:activeWorkspaceChanged) 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' screen #activeWorkspaceChanged callback
-- @
-- 
-- 
onScreenActiveWorkspaceChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenActiveWorkspaceChangedCallback) -> m SignalHandlerId
onScreenActiveWorkspaceChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWorkspaceChangedCallback)
-> m SignalHandlerId
onScreenActiveWorkspaceChanged a
obj (?self::a) => ScreenActiveWorkspaceChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWorkspaceChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWorkspaceChangedCallback
ScreenActiveWorkspaceChangedCallback
cb
    let wrapped' :: C_ScreenActiveWorkspaceChangedCallback
wrapped' = (a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
wrap_ScreenActiveWorkspaceChangedCallback a -> ScreenActiveWorkspaceChangedCallback
wrapped
    FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' <- C_ScreenActiveWorkspaceChangedCallback
-> IO (FunPtr C_ScreenActiveWorkspaceChangedCallback)
mk_ScreenActiveWorkspaceChangedCallback C_ScreenActiveWorkspaceChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWorkspaceChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"active-workspace-changed" FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [activeWorkspaceChanged](#signal:activeWorkspaceChanged) 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' screen #activeWorkspaceChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenActiveWorkspaceChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenActiveWorkspaceChangedCallback) -> m SignalHandlerId
afterScreenActiveWorkspaceChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWorkspaceChangedCallback)
-> m SignalHandlerId
afterScreenActiveWorkspaceChanged a
obj (?self::a) => ScreenActiveWorkspaceChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWorkspaceChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWorkspaceChangedCallback
ScreenActiveWorkspaceChangedCallback
cb
    let wrapped' :: C_ScreenActiveWorkspaceChangedCallback
wrapped' = (a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
wrap_ScreenActiveWorkspaceChangedCallback a -> ScreenActiveWorkspaceChangedCallback
wrapped
    FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' <- C_ScreenActiveWorkspaceChangedCallback
-> IO (FunPtr C_ScreenActiveWorkspaceChangedCallback)
mk_ScreenActiveWorkspaceChangedCallback C_ScreenActiveWorkspaceChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWorkspaceChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"active-workspace-changed" FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenActiveWorkspaceChangedSignalInfo
instance SignalInfo ScreenActiveWorkspaceChangedSignalInfo where
    type HaskellCallbackType ScreenActiveWorkspaceChangedSignalInfo = ScreenActiveWorkspaceChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenActiveWorkspaceChangedCallback cb
        cb'' <- mk_ScreenActiveWorkspaceChangedCallback cb'
        connectSignalFunPtr obj "active-workspace-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::active-workspace-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:activeWorkspaceChanged"})

#endif

-- signal Screen::application-closed
-- | Emitted when a t'GI.Wnck.Objects.Application.Application' is closed on /@screen@/.
type ScreenApplicationClosedCallback =
    Wnck.Application.Application
    -- ^ /@app@/: the closed t'GI.Wnck.Objects.Application.Application'.
    -> IO ()

type C_ScreenApplicationClosedCallback =
    Ptr Screen ->                           -- object
    Ptr Wnck.Application.Application ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenApplicationClosedCallback :: 
    GObject a => (a -> ScreenApplicationClosedCallback) ->
    C_ScreenApplicationClosedCallback
wrap_ScreenApplicationClosedCallback :: forall a.
GObject a =>
(a -> ScreenApplicationClosedCallback)
-> C_ScreenApplicationClosedCallback
wrap_ScreenApplicationClosedCallback a -> ScreenApplicationClosedCallback
gi'cb Ptr Screen
gi'selfPtr Ptr Application
app Ptr ()
_ = do
    Application
app' <- ((ManagedPtr Application -> Application)
-> Ptr Application -> IO Application
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Application -> Application
Wnck.Application.Application) Ptr Application
app
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> ScreenApplicationClosedCallback
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self)  Application
app'


-- | Connect a signal handler for the [applicationClosed](#signal:applicationClosed) 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' screen #applicationClosed callback
-- @
-- 
-- 
onScreenApplicationClosed :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenApplicationClosedCallback) -> m SignalHandlerId
onScreenApplicationClosed :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenApplicationClosedCallback)
-> m SignalHandlerId
onScreenApplicationClosed a
obj (?self::a) => ScreenApplicationClosedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenApplicationClosedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenApplicationClosedCallback
ScreenApplicationClosedCallback
cb
    let wrapped' :: C_ScreenApplicationClosedCallback
wrapped' = (a -> ScreenApplicationClosedCallback)
-> C_ScreenApplicationClosedCallback
forall a.
GObject a =>
(a -> ScreenApplicationClosedCallback)
-> C_ScreenApplicationClosedCallback
wrap_ScreenApplicationClosedCallback a -> ScreenApplicationClosedCallback
wrapped
    FunPtr C_ScreenApplicationClosedCallback
wrapped'' <- C_ScreenApplicationClosedCallback
-> IO (FunPtr C_ScreenApplicationClosedCallback)
mk_ScreenApplicationClosedCallback C_ScreenApplicationClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenApplicationClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"application-closed" FunPtr C_ScreenApplicationClosedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [applicationClosed](#signal:applicationClosed) 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' screen #applicationClosed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenApplicationClosed :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenApplicationClosedCallback) -> m SignalHandlerId
afterScreenApplicationClosed :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenApplicationClosedCallback)
-> m SignalHandlerId
afterScreenApplicationClosed a
obj (?self::a) => ScreenApplicationClosedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenApplicationClosedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenApplicationClosedCallback
ScreenApplicationClosedCallback
cb
    let wrapped' :: C_ScreenApplicationClosedCallback
wrapped' = (a -> ScreenApplicationClosedCallback)
-> C_ScreenApplicationClosedCallback
forall a.
GObject a =>
(a -> ScreenApplicationClosedCallback)
-> C_ScreenApplicationClosedCallback
wrap_ScreenApplicationClosedCallback a -> ScreenApplicationClosedCallback
wrapped
    FunPtr C_ScreenApplicationClosedCallback
wrapped'' <- C_ScreenApplicationClosedCallback
-> IO (FunPtr C_ScreenApplicationClosedCallback)
mk_ScreenApplicationClosedCallback C_ScreenApplicationClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenApplicationClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"application-closed" FunPtr C_ScreenApplicationClosedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenApplicationClosedSignalInfo
instance SignalInfo ScreenApplicationClosedSignalInfo where
    type HaskellCallbackType ScreenApplicationClosedSignalInfo = ScreenApplicationClosedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenApplicationClosedCallback cb
        cb'' <- mk_ScreenApplicationClosedCallback cb'
        connectSignalFunPtr obj "application-closed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::application-closed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:applicationClosed"})

#endif

-- signal Screen::application-opened
-- | Emitted when a new t'GI.Wnck.Objects.Application.Application' is opened on /@screen@/.
type ScreenApplicationOpenedCallback =
    Wnck.Application.Application
    -- ^ /@app@/: the opened t'GI.Wnck.Objects.Application.Application'.
    -> IO ()

type C_ScreenApplicationOpenedCallback =
    Ptr Screen ->                           -- object
    Ptr Wnck.Application.Application ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenApplicationOpenedCallback :: 
    GObject a => (a -> ScreenApplicationOpenedCallback) ->
    C_ScreenApplicationOpenedCallback
wrap_ScreenApplicationOpenedCallback :: forall a.
GObject a =>
(a -> ScreenApplicationClosedCallback)
-> C_ScreenApplicationClosedCallback
wrap_ScreenApplicationOpenedCallback a -> ScreenApplicationClosedCallback
gi'cb Ptr Screen
gi'selfPtr Ptr Application
app Ptr ()
_ = do
    Application
app' <- ((ManagedPtr Application -> Application)
-> Ptr Application -> IO Application
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Application -> Application
Wnck.Application.Application) Ptr Application
app
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> ScreenApplicationClosedCallback
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self)  Application
app'


-- | Connect a signal handler for the [applicationOpened](#signal:applicationOpened) 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' screen #applicationOpened callback
-- @
-- 
-- 
onScreenApplicationOpened :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenApplicationOpenedCallback) -> m SignalHandlerId
onScreenApplicationOpened :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenApplicationClosedCallback)
-> m SignalHandlerId
onScreenApplicationOpened a
obj (?self::a) => ScreenApplicationClosedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenApplicationClosedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenApplicationClosedCallback
ScreenApplicationClosedCallback
cb
    let wrapped' :: C_ScreenApplicationClosedCallback
wrapped' = (a -> ScreenApplicationClosedCallback)
-> C_ScreenApplicationClosedCallback
forall a.
GObject a =>
(a -> ScreenApplicationClosedCallback)
-> C_ScreenApplicationClosedCallback
wrap_ScreenApplicationOpenedCallback a -> ScreenApplicationClosedCallback
wrapped
    FunPtr C_ScreenApplicationClosedCallback
wrapped'' <- C_ScreenApplicationClosedCallback
-> IO (FunPtr C_ScreenApplicationClosedCallback)
mk_ScreenApplicationOpenedCallback C_ScreenApplicationClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenApplicationClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"application-opened" FunPtr C_ScreenApplicationClosedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [applicationOpened](#signal:applicationOpened) 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' screen #applicationOpened callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenApplicationOpened :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenApplicationOpenedCallback) -> m SignalHandlerId
afterScreenApplicationOpened :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenApplicationClosedCallback)
-> m SignalHandlerId
afterScreenApplicationOpened a
obj (?self::a) => ScreenApplicationClosedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenApplicationClosedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenApplicationClosedCallback
ScreenApplicationClosedCallback
cb
    let wrapped' :: C_ScreenApplicationClosedCallback
wrapped' = (a -> ScreenApplicationClosedCallback)
-> C_ScreenApplicationClosedCallback
forall a.
GObject a =>
(a -> ScreenApplicationClosedCallback)
-> C_ScreenApplicationClosedCallback
wrap_ScreenApplicationOpenedCallback a -> ScreenApplicationClosedCallback
wrapped
    FunPtr C_ScreenApplicationClosedCallback
wrapped'' <- C_ScreenApplicationClosedCallback
-> IO (FunPtr C_ScreenApplicationClosedCallback)
mk_ScreenApplicationOpenedCallback C_ScreenApplicationClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenApplicationClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"application-opened" FunPtr C_ScreenApplicationClosedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenApplicationOpenedSignalInfo
instance SignalInfo ScreenApplicationOpenedSignalInfo where
    type HaskellCallbackType ScreenApplicationOpenedSignalInfo = ScreenApplicationOpenedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenApplicationOpenedCallback cb
        cb'' <- mk_ScreenApplicationOpenedCallback cb'
        connectSignalFunPtr obj "application-opened" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::application-opened"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:applicationOpened"})

#endif

-- signal Screen::background-changed
-- | Emitted when the background on the root window of /@screen@/ has changed.
type ScreenBackgroundChangedCallback =
    IO ()

type C_ScreenBackgroundChangedCallback =
    Ptr Screen ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenBackgroundChangedCallback :: 
    GObject a => (a -> ScreenBackgroundChangedCallback) ->
    C_ScreenBackgroundChangedCallback
wrap_ScreenBackgroundChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenBackgroundChangedCallback a -> IO ()
gi'cb Ptr Screen
gi'selfPtr Ptr ()
_ = do
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> IO ()
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self) 


-- | Connect a signal handler for the [backgroundChanged](#signal:backgroundChanged) 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' screen #backgroundChanged callback
-- @
-- 
-- 
onScreenBackgroundChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenBackgroundChangedCallback) -> m SignalHandlerId
onScreenBackgroundChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onScreenBackgroundChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ScreenBackgroundChangedCallback
wrapped' = (a -> IO ()) -> C_ScreenBackgroundChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenBackgroundChangedCallback a -> IO ()
wrapped
    FunPtr C_ScreenBackgroundChangedCallback
wrapped'' <- C_ScreenBackgroundChangedCallback
-> IO (FunPtr C_ScreenBackgroundChangedCallback)
mk_ScreenBackgroundChangedCallback C_ScreenBackgroundChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenBackgroundChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"background-changed" FunPtr C_ScreenBackgroundChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [backgroundChanged](#signal:backgroundChanged) 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' screen #backgroundChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenBackgroundChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenBackgroundChangedCallback) -> m SignalHandlerId
afterScreenBackgroundChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterScreenBackgroundChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ScreenBackgroundChangedCallback
wrapped' = (a -> IO ()) -> C_ScreenBackgroundChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenBackgroundChangedCallback a -> IO ()
wrapped
    FunPtr C_ScreenBackgroundChangedCallback
wrapped'' <- C_ScreenBackgroundChangedCallback
-> IO (FunPtr C_ScreenBackgroundChangedCallback)
mk_ScreenBackgroundChangedCallback C_ScreenBackgroundChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenBackgroundChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"background-changed" FunPtr C_ScreenBackgroundChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenBackgroundChangedSignalInfo
instance SignalInfo ScreenBackgroundChangedSignalInfo where
    type HaskellCallbackType ScreenBackgroundChangedSignalInfo = ScreenBackgroundChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenBackgroundChangedCallback cb
        cb'' <- mk_ScreenBackgroundChangedCallback cb'
        connectSignalFunPtr obj "background-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::background-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:backgroundChanged"})

#endif

-- signal Screen::class-group-closed
-- | Emitted when a t'GI.Wnck.Objects.ClassGroup.ClassGroup' is closed on /@screen@/.
-- 
-- /Since: 2.20/
type ScreenClassGroupClosedCallback =
    Wnck.ClassGroup.ClassGroup
    -- ^ /@classGroup@/: the closed t'GI.Wnck.Objects.ClassGroup.ClassGroup'.
    -> IO ()

type C_ScreenClassGroupClosedCallback =
    Ptr Screen ->                           -- object
    Ptr Wnck.ClassGroup.ClassGroup ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenClassGroupClosedCallback :: 
    GObject a => (a -> ScreenClassGroupClosedCallback) ->
    C_ScreenClassGroupClosedCallback
wrap_ScreenClassGroupClosedCallback :: forall a.
GObject a =>
(a -> ScreenClassGroupClosedCallback)
-> C_ScreenClassGroupClosedCallback
wrap_ScreenClassGroupClosedCallback a -> ScreenClassGroupClosedCallback
gi'cb Ptr Screen
gi'selfPtr Ptr ClassGroup
classGroup Ptr ()
_ = do
    ClassGroup
classGroup' <- ((ManagedPtr ClassGroup -> ClassGroup)
-> Ptr ClassGroup -> IO ClassGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ClassGroup -> ClassGroup
Wnck.ClassGroup.ClassGroup) Ptr ClassGroup
classGroup
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> ScreenClassGroupClosedCallback
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self)  ClassGroup
classGroup'


-- | Connect a signal handler for the [classGroupClosed](#signal:classGroupClosed) 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' screen #classGroupClosed callback
-- @
-- 
-- 
onScreenClassGroupClosed :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenClassGroupClosedCallback) -> m SignalHandlerId
onScreenClassGroupClosed :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenClassGroupClosedCallback)
-> m SignalHandlerId
onScreenClassGroupClosed a
obj (?self::a) => ScreenClassGroupClosedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenClassGroupClosedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenClassGroupClosedCallback
ScreenClassGroupClosedCallback
cb
    let wrapped' :: C_ScreenClassGroupClosedCallback
wrapped' = (a -> ScreenClassGroupClosedCallback)
-> C_ScreenClassGroupClosedCallback
forall a.
GObject a =>
(a -> ScreenClassGroupClosedCallback)
-> C_ScreenClassGroupClosedCallback
wrap_ScreenClassGroupClosedCallback a -> ScreenClassGroupClosedCallback
wrapped
    FunPtr C_ScreenClassGroupClosedCallback
wrapped'' <- C_ScreenClassGroupClosedCallback
-> IO (FunPtr C_ScreenClassGroupClosedCallback)
mk_ScreenClassGroupClosedCallback C_ScreenClassGroupClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenClassGroupClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"class-group-closed" FunPtr C_ScreenClassGroupClosedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [classGroupClosed](#signal:classGroupClosed) 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' screen #classGroupClosed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenClassGroupClosed :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenClassGroupClosedCallback) -> m SignalHandlerId
afterScreenClassGroupClosed :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenClassGroupClosedCallback)
-> m SignalHandlerId
afterScreenClassGroupClosed a
obj (?self::a) => ScreenClassGroupClosedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenClassGroupClosedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenClassGroupClosedCallback
ScreenClassGroupClosedCallback
cb
    let wrapped' :: C_ScreenClassGroupClosedCallback
wrapped' = (a -> ScreenClassGroupClosedCallback)
-> C_ScreenClassGroupClosedCallback
forall a.
GObject a =>
(a -> ScreenClassGroupClosedCallback)
-> C_ScreenClassGroupClosedCallback
wrap_ScreenClassGroupClosedCallback a -> ScreenClassGroupClosedCallback
wrapped
    FunPtr C_ScreenClassGroupClosedCallback
wrapped'' <- C_ScreenClassGroupClosedCallback
-> IO (FunPtr C_ScreenClassGroupClosedCallback)
mk_ScreenClassGroupClosedCallback C_ScreenClassGroupClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenClassGroupClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"class-group-closed" FunPtr C_ScreenClassGroupClosedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenClassGroupClosedSignalInfo
instance SignalInfo ScreenClassGroupClosedSignalInfo where
    type HaskellCallbackType ScreenClassGroupClosedSignalInfo = ScreenClassGroupClosedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenClassGroupClosedCallback cb
        cb'' <- mk_ScreenClassGroupClosedCallback cb'
        connectSignalFunPtr obj "class-group-closed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::class-group-closed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:classGroupClosed"})

#endif

-- signal Screen::class-group-opened
-- | Emitted when a new t'GI.Wnck.Objects.ClassGroup.ClassGroup' is opened on /@screen@/.
-- 
-- /Since: 2.20/
type ScreenClassGroupOpenedCallback =
    Wnck.ClassGroup.ClassGroup
    -- ^ /@classGroup@/: the opened t'GI.Wnck.Objects.ClassGroup.ClassGroup'.
    -> IO ()

type C_ScreenClassGroupOpenedCallback =
    Ptr Screen ->                           -- object
    Ptr Wnck.ClassGroup.ClassGroup ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenClassGroupOpenedCallback :: 
    GObject a => (a -> ScreenClassGroupOpenedCallback) ->
    C_ScreenClassGroupOpenedCallback
wrap_ScreenClassGroupOpenedCallback :: forall a.
GObject a =>
(a -> ScreenClassGroupClosedCallback)
-> C_ScreenClassGroupClosedCallback
wrap_ScreenClassGroupOpenedCallback a -> ScreenClassGroupClosedCallback
gi'cb Ptr Screen
gi'selfPtr Ptr ClassGroup
classGroup Ptr ()
_ = do
    ClassGroup
classGroup' <- ((ManagedPtr ClassGroup -> ClassGroup)
-> Ptr ClassGroup -> IO ClassGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ClassGroup -> ClassGroup
Wnck.ClassGroup.ClassGroup) Ptr ClassGroup
classGroup
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> ScreenClassGroupClosedCallback
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self)  ClassGroup
classGroup'


-- | Connect a signal handler for the [classGroupOpened](#signal:classGroupOpened) 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' screen #classGroupOpened callback
-- @
-- 
-- 
onScreenClassGroupOpened :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenClassGroupOpenedCallback) -> m SignalHandlerId
onScreenClassGroupOpened :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenClassGroupClosedCallback)
-> m SignalHandlerId
onScreenClassGroupOpened a
obj (?self::a) => ScreenClassGroupClosedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenClassGroupClosedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenClassGroupClosedCallback
ScreenClassGroupClosedCallback
cb
    let wrapped' :: C_ScreenClassGroupClosedCallback
wrapped' = (a -> ScreenClassGroupClosedCallback)
-> C_ScreenClassGroupClosedCallback
forall a.
GObject a =>
(a -> ScreenClassGroupClosedCallback)
-> C_ScreenClassGroupClosedCallback
wrap_ScreenClassGroupOpenedCallback a -> ScreenClassGroupClosedCallback
wrapped
    FunPtr C_ScreenClassGroupClosedCallback
wrapped'' <- C_ScreenClassGroupClosedCallback
-> IO (FunPtr C_ScreenClassGroupClosedCallback)
mk_ScreenClassGroupOpenedCallback C_ScreenClassGroupClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenClassGroupClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"class-group-opened" FunPtr C_ScreenClassGroupClosedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [classGroupOpened](#signal:classGroupOpened) 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' screen #classGroupOpened callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenClassGroupOpened :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenClassGroupOpenedCallback) -> m SignalHandlerId
afterScreenClassGroupOpened :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenClassGroupClosedCallback)
-> m SignalHandlerId
afterScreenClassGroupOpened a
obj (?self::a) => ScreenClassGroupClosedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenClassGroupClosedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenClassGroupClosedCallback
ScreenClassGroupClosedCallback
cb
    let wrapped' :: C_ScreenClassGroupClosedCallback
wrapped' = (a -> ScreenClassGroupClosedCallback)
-> C_ScreenClassGroupClosedCallback
forall a.
GObject a =>
(a -> ScreenClassGroupClosedCallback)
-> C_ScreenClassGroupClosedCallback
wrap_ScreenClassGroupOpenedCallback a -> ScreenClassGroupClosedCallback
wrapped
    FunPtr C_ScreenClassGroupClosedCallback
wrapped'' <- C_ScreenClassGroupClosedCallback
-> IO (FunPtr C_ScreenClassGroupClosedCallback)
mk_ScreenClassGroupOpenedCallback C_ScreenClassGroupClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenClassGroupClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"class-group-opened" FunPtr C_ScreenClassGroupClosedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenClassGroupOpenedSignalInfo
instance SignalInfo ScreenClassGroupOpenedSignalInfo where
    type HaskellCallbackType ScreenClassGroupOpenedSignalInfo = ScreenClassGroupOpenedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenClassGroupOpenedCallback cb
        cb'' <- mk_ScreenClassGroupOpenedCallback cb'
        connectSignalFunPtr obj "class-group-opened" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::class-group-opened"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:classGroupOpened"})

#endif

-- signal Screen::showing-desktop-changed
-- | Emitted when \"showing the desktop\" mode of /@screen@/ is toggled.
-- 
-- /Since: 2.20/
type ScreenShowingDesktopChangedCallback =
    IO ()

type C_ScreenShowingDesktopChangedCallback =
    Ptr Screen ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenShowingDesktopChangedCallback :: 
    GObject a => (a -> ScreenShowingDesktopChangedCallback) ->
    C_ScreenShowingDesktopChangedCallback
wrap_ScreenShowingDesktopChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenShowingDesktopChangedCallback a -> IO ()
gi'cb Ptr Screen
gi'selfPtr Ptr ()
_ = do
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> IO ()
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self) 


-- | Connect a signal handler for the [showingDesktopChanged](#signal:showingDesktopChanged) 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' screen #showingDesktopChanged callback
-- @
-- 
-- 
onScreenShowingDesktopChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenShowingDesktopChangedCallback) -> m SignalHandlerId
onScreenShowingDesktopChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onScreenShowingDesktopChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ScreenBackgroundChangedCallback
wrapped' = (a -> IO ()) -> C_ScreenBackgroundChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenShowingDesktopChangedCallback a -> IO ()
wrapped
    FunPtr C_ScreenBackgroundChangedCallback
wrapped'' <- C_ScreenBackgroundChangedCallback
-> IO (FunPtr C_ScreenBackgroundChangedCallback)
mk_ScreenShowingDesktopChangedCallback C_ScreenBackgroundChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenBackgroundChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"showing-desktop-changed" FunPtr C_ScreenBackgroundChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [showingDesktopChanged](#signal:showingDesktopChanged) 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' screen #showingDesktopChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenShowingDesktopChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenShowingDesktopChangedCallback) -> m SignalHandlerId
afterScreenShowingDesktopChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterScreenShowingDesktopChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ScreenBackgroundChangedCallback
wrapped' = (a -> IO ()) -> C_ScreenBackgroundChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenShowingDesktopChangedCallback a -> IO ()
wrapped
    FunPtr C_ScreenBackgroundChangedCallback
wrapped'' <- C_ScreenBackgroundChangedCallback
-> IO (FunPtr C_ScreenBackgroundChangedCallback)
mk_ScreenShowingDesktopChangedCallback C_ScreenBackgroundChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenBackgroundChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"showing-desktop-changed" FunPtr C_ScreenBackgroundChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenShowingDesktopChangedSignalInfo
instance SignalInfo ScreenShowingDesktopChangedSignalInfo where
    type HaskellCallbackType ScreenShowingDesktopChangedSignalInfo = ScreenShowingDesktopChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenShowingDesktopChangedCallback cb
        cb'' <- mk_ScreenShowingDesktopChangedCallback cb'
        connectSignalFunPtr obj "showing-desktop-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::showing-desktop-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:showingDesktopChanged"})

#endif

-- signal Screen::viewports-changed
-- | Emitted when a viewport position has changed in a t'GI.Wnck.Objects.Workspace.Workspace' of
-- /@screen@/ or when a t'GI.Wnck.Objects.Workspace.Workspace' of /@screen@/ gets or loses its viewport.
-- 
-- /Since: 2.20/
type ScreenViewportsChangedCallback =
    IO ()

type C_ScreenViewportsChangedCallback =
    Ptr Screen ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenViewportsChangedCallback :: 
    GObject a => (a -> ScreenViewportsChangedCallback) ->
    C_ScreenViewportsChangedCallback
wrap_ScreenViewportsChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenViewportsChangedCallback a -> IO ()
gi'cb Ptr Screen
gi'selfPtr Ptr ()
_ = do
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> IO ()
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self) 


-- | Connect a signal handler for the [viewportsChanged](#signal:viewportsChanged) 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' screen #viewportsChanged callback
-- @
-- 
-- 
onScreenViewportsChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenViewportsChangedCallback) -> m SignalHandlerId
onScreenViewportsChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onScreenViewportsChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ScreenBackgroundChangedCallback
wrapped' = (a -> IO ()) -> C_ScreenBackgroundChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenViewportsChangedCallback a -> IO ()
wrapped
    FunPtr C_ScreenBackgroundChangedCallback
wrapped'' <- C_ScreenBackgroundChangedCallback
-> IO (FunPtr C_ScreenBackgroundChangedCallback)
mk_ScreenViewportsChangedCallback C_ScreenBackgroundChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenBackgroundChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"viewports-changed" FunPtr C_ScreenBackgroundChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [viewportsChanged](#signal:viewportsChanged) 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' screen #viewportsChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenViewportsChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenViewportsChangedCallback) -> m SignalHandlerId
afterScreenViewportsChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterScreenViewportsChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ScreenBackgroundChangedCallback
wrapped' = (a -> IO ()) -> C_ScreenBackgroundChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenViewportsChangedCallback a -> IO ()
wrapped
    FunPtr C_ScreenBackgroundChangedCallback
wrapped'' <- C_ScreenBackgroundChangedCallback
-> IO (FunPtr C_ScreenBackgroundChangedCallback)
mk_ScreenViewportsChangedCallback C_ScreenBackgroundChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenBackgroundChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"viewports-changed" FunPtr C_ScreenBackgroundChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenViewportsChangedSignalInfo
instance SignalInfo ScreenViewportsChangedSignalInfo where
    type HaskellCallbackType ScreenViewportsChangedSignalInfo = ScreenViewportsChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenViewportsChangedCallback cb
        cb'' <- mk_ScreenViewportsChangedCallback cb'
        connectSignalFunPtr obj "viewports-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::viewports-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:viewportsChanged"})

#endif

-- signal Screen::window-closed
-- | Emitted when a t'GI.Wnck.Objects.Window.Window' is closed on /@screen@/.
type ScreenWindowClosedCallback =
    Wnck.Window.Window
    -- ^ /@window@/: the closed t'GI.Wnck.Objects.Window.Window'.
    -> IO ()

type C_ScreenWindowClosedCallback =
    Ptr Screen ->                           -- object
    Ptr Wnck.Window.Window ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenWindowClosedCallback :: 
    GObject a => (a -> ScreenWindowClosedCallback) ->
    C_ScreenWindowClosedCallback
wrap_ScreenWindowClosedCallback :: forall a.
GObject a =>
(a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
wrap_ScreenWindowClosedCallback a -> ScreenActiveWindowChangedCallback
gi'cb Ptr Screen
gi'selfPtr Ptr Window
window Ptr ()
_ = do
    Window
window' <- ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Wnck.Window.Window) Ptr Window
window
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> ScreenActiveWindowChangedCallback
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self)  Window
window'


-- | Connect a signal handler for the [windowClosed](#signal:windowClosed) 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' screen #windowClosed callback
-- @
-- 
-- 
onScreenWindowClosed :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWindowClosedCallback) -> m SignalHandlerId
onScreenWindowClosed :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWindowChangedCallback)
-> m SignalHandlerId
onScreenWindowClosed a
obj (?self::a) => ScreenActiveWindowChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWindowChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWindowChangedCallback
ScreenActiveWindowChangedCallback
cb
    let wrapped' :: C_ScreenActiveWindowChangedCallback
wrapped' = (a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
wrap_ScreenWindowClosedCallback a -> ScreenActiveWindowChangedCallback
wrapped
    FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' <- C_ScreenActiveWindowChangedCallback
-> IO (FunPtr C_ScreenActiveWindowChangedCallback)
mk_ScreenWindowClosedCallback C_ScreenActiveWindowChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWindowChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"window-closed" FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [windowClosed](#signal:windowClosed) 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' screen #windowClosed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenWindowClosed :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWindowClosedCallback) -> m SignalHandlerId
afterScreenWindowClosed :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWindowChangedCallback)
-> m SignalHandlerId
afterScreenWindowClosed a
obj (?self::a) => ScreenActiveWindowChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWindowChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWindowChangedCallback
ScreenActiveWindowChangedCallback
cb
    let wrapped' :: C_ScreenActiveWindowChangedCallback
wrapped' = (a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
wrap_ScreenWindowClosedCallback a -> ScreenActiveWindowChangedCallback
wrapped
    FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' <- C_ScreenActiveWindowChangedCallback
-> IO (FunPtr C_ScreenActiveWindowChangedCallback)
mk_ScreenWindowClosedCallback C_ScreenActiveWindowChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWindowChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"window-closed" FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenWindowClosedSignalInfo
instance SignalInfo ScreenWindowClosedSignalInfo where
    type HaskellCallbackType ScreenWindowClosedSignalInfo = ScreenWindowClosedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenWindowClosedCallback cb
        cb'' <- mk_ScreenWindowClosedCallback cb'
        connectSignalFunPtr obj "window-closed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::window-closed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:windowClosed"})

#endif

-- signal Screen::window-manager-changed
-- | Emitted when the window manager on /@screen@/ has changed.
-- 
-- /Since: 2.20/
type ScreenWindowManagerChangedCallback =
    IO ()

type C_ScreenWindowManagerChangedCallback =
    Ptr Screen ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenWindowManagerChangedCallback :: 
    GObject a => (a -> ScreenWindowManagerChangedCallback) ->
    C_ScreenWindowManagerChangedCallback
wrap_ScreenWindowManagerChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenWindowManagerChangedCallback a -> IO ()
gi'cb Ptr Screen
gi'selfPtr Ptr ()
_ = do
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> IO ()
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self) 


-- | Connect a signal handler for the [windowManagerChanged](#signal:windowManagerChanged) 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' screen #windowManagerChanged callback
-- @
-- 
-- 
onScreenWindowManagerChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWindowManagerChangedCallback) -> m SignalHandlerId
onScreenWindowManagerChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onScreenWindowManagerChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ScreenBackgroundChangedCallback
wrapped' = (a -> IO ()) -> C_ScreenBackgroundChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenWindowManagerChangedCallback a -> IO ()
wrapped
    FunPtr C_ScreenBackgroundChangedCallback
wrapped'' <- C_ScreenBackgroundChangedCallback
-> IO (FunPtr C_ScreenBackgroundChangedCallback)
mk_ScreenWindowManagerChangedCallback C_ScreenBackgroundChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenBackgroundChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"window-manager-changed" FunPtr C_ScreenBackgroundChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [windowManagerChanged](#signal:windowManagerChanged) 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' screen #windowManagerChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenWindowManagerChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWindowManagerChangedCallback) -> m SignalHandlerId
afterScreenWindowManagerChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterScreenWindowManagerChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ScreenBackgroundChangedCallback
wrapped' = (a -> IO ()) -> C_ScreenBackgroundChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenWindowManagerChangedCallback a -> IO ()
wrapped
    FunPtr C_ScreenBackgroundChangedCallback
wrapped'' <- C_ScreenBackgroundChangedCallback
-> IO (FunPtr C_ScreenBackgroundChangedCallback)
mk_ScreenWindowManagerChangedCallback C_ScreenBackgroundChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenBackgroundChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"window-manager-changed" FunPtr C_ScreenBackgroundChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenWindowManagerChangedSignalInfo
instance SignalInfo ScreenWindowManagerChangedSignalInfo where
    type HaskellCallbackType ScreenWindowManagerChangedSignalInfo = ScreenWindowManagerChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenWindowManagerChangedCallback cb
        cb'' <- mk_ScreenWindowManagerChangedCallback cb'
        connectSignalFunPtr obj "window-manager-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::window-manager-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:windowManagerChanged"})

#endif

-- signal Screen::window-opened
-- | Emitted when a new t'GI.Wnck.Objects.Window.Window' is opened on /@screen@/.
type ScreenWindowOpenedCallback =
    Wnck.Window.Window
    -- ^ /@window@/: the opened t'GI.Wnck.Objects.Window.Window'.
    -> IO ()

type C_ScreenWindowOpenedCallback =
    Ptr Screen ->                           -- object
    Ptr Wnck.Window.Window ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenWindowOpenedCallback :: 
    GObject a => (a -> ScreenWindowOpenedCallback) ->
    C_ScreenWindowOpenedCallback
wrap_ScreenWindowOpenedCallback :: forall a.
GObject a =>
(a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
wrap_ScreenWindowOpenedCallback a -> ScreenActiveWindowChangedCallback
gi'cb Ptr Screen
gi'selfPtr Ptr Window
window Ptr ()
_ = do
    Window
window' <- ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Wnck.Window.Window) Ptr Window
window
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> ScreenActiveWindowChangedCallback
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self)  Window
window'


-- | Connect a signal handler for the [windowOpened](#signal:windowOpened) 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' screen #windowOpened callback
-- @
-- 
-- 
onScreenWindowOpened :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWindowOpenedCallback) -> m SignalHandlerId
onScreenWindowOpened :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWindowChangedCallback)
-> m SignalHandlerId
onScreenWindowOpened a
obj (?self::a) => ScreenActiveWindowChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWindowChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWindowChangedCallback
ScreenActiveWindowChangedCallback
cb
    let wrapped' :: C_ScreenActiveWindowChangedCallback
wrapped' = (a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
wrap_ScreenWindowOpenedCallback a -> ScreenActiveWindowChangedCallback
wrapped
    FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' <- C_ScreenActiveWindowChangedCallback
-> IO (FunPtr C_ScreenActiveWindowChangedCallback)
mk_ScreenWindowOpenedCallback C_ScreenActiveWindowChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWindowChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"window-opened" FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [windowOpened](#signal:windowOpened) 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' screen #windowOpened callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenWindowOpened :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWindowOpenedCallback) -> m SignalHandlerId
afterScreenWindowOpened :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWindowChangedCallback)
-> m SignalHandlerId
afterScreenWindowOpened a
obj (?self::a) => ScreenActiveWindowChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWindowChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWindowChangedCallback
ScreenActiveWindowChangedCallback
cb
    let wrapped' :: C_ScreenActiveWindowChangedCallback
wrapped' = (a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWindowChangedCallback)
-> C_ScreenActiveWindowChangedCallback
wrap_ScreenWindowOpenedCallback a -> ScreenActiveWindowChangedCallback
wrapped
    FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' <- C_ScreenActiveWindowChangedCallback
-> IO (FunPtr C_ScreenActiveWindowChangedCallback)
mk_ScreenWindowOpenedCallback C_ScreenActiveWindowChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWindowChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"window-opened" FunPtr C_ScreenActiveWindowChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenWindowOpenedSignalInfo
instance SignalInfo ScreenWindowOpenedSignalInfo where
    type HaskellCallbackType ScreenWindowOpenedSignalInfo = ScreenWindowOpenedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenWindowOpenedCallback cb
        cb'' <- mk_ScreenWindowOpenedCallback cb'
        connectSignalFunPtr obj "window-opened" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::window-opened"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:windowOpened"})

#endif

-- signal Screen::window-stacking-changed
-- | Emitted when the stacking order of t'GI.Wnck.Objects.Window.Window' on /@screen@/ has changed.
type ScreenWindowStackingChangedCallback =
    IO ()

type C_ScreenWindowStackingChangedCallback =
    Ptr Screen ->                           -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenWindowStackingChangedCallback :: 
    GObject a => (a -> ScreenWindowStackingChangedCallback) ->
    C_ScreenWindowStackingChangedCallback
wrap_ScreenWindowStackingChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenWindowStackingChangedCallback a -> IO ()
gi'cb Ptr Screen
gi'selfPtr Ptr ()
_ = do
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> IO ()
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self) 


-- | Connect a signal handler for the [windowStackingChanged](#signal:windowStackingChanged) 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' screen #windowStackingChanged callback
-- @
-- 
-- 
onScreenWindowStackingChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWindowStackingChangedCallback) -> m SignalHandlerId
onScreenWindowStackingChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onScreenWindowStackingChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ScreenBackgroundChangedCallback
wrapped' = (a -> IO ()) -> C_ScreenBackgroundChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenWindowStackingChangedCallback a -> IO ()
wrapped
    FunPtr C_ScreenBackgroundChangedCallback
wrapped'' <- C_ScreenBackgroundChangedCallback
-> IO (FunPtr C_ScreenBackgroundChangedCallback)
mk_ScreenWindowStackingChangedCallback C_ScreenBackgroundChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenBackgroundChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"window-stacking-changed" FunPtr C_ScreenBackgroundChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [windowStackingChanged](#signal:windowStackingChanged) 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' screen #windowStackingChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenWindowStackingChanged :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWindowStackingChangedCallback) -> m SignalHandlerId
afterScreenWindowStackingChanged :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterScreenWindowStackingChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ScreenBackgroundChangedCallback
wrapped' = (a -> IO ()) -> C_ScreenBackgroundChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ScreenBackgroundChangedCallback
wrap_ScreenWindowStackingChangedCallback a -> IO ()
wrapped
    FunPtr C_ScreenBackgroundChangedCallback
wrapped'' <- C_ScreenBackgroundChangedCallback
-> IO (FunPtr C_ScreenBackgroundChangedCallback)
mk_ScreenWindowStackingChangedCallback C_ScreenBackgroundChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenBackgroundChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"window-stacking-changed" FunPtr C_ScreenBackgroundChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenWindowStackingChangedSignalInfo
instance SignalInfo ScreenWindowStackingChangedSignalInfo where
    type HaskellCallbackType ScreenWindowStackingChangedSignalInfo = ScreenWindowStackingChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenWindowStackingChangedCallback cb
        cb'' <- mk_ScreenWindowStackingChangedCallback cb'
        connectSignalFunPtr obj "window-stacking-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::window-stacking-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:windowStackingChanged"})

#endif

-- signal Screen::workspace-created
-- | Emitted when a t'GI.Wnck.Objects.Workspace.Workspace' is created on /@screen@/.
type ScreenWorkspaceCreatedCallback =
    Wnck.Workspace.Workspace
    -- ^ /@space@/: the workspace that has been created.
    -> IO ()

type C_ScreenWorkspaceCreatedCallback =
    Ptr Screen ->                           -- object
    Ptr Wnck.Workspace.Workspace ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenWorkspaceCreatedCallback :: 
    GObject a => (a -> ScreenWorkspaceCreatedCallback) ->
    C_ScreenWorkspaceCreatedCallback
wrap_ScreenWorkspaceCreatedCallback :: forall a.
GObject a =>
(a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
wrap_ScreenWorkspaceCreatedCallback a -> ScreenActiveWorkspaceChangedCallback
gi'cb Ptr Screen
gi'selfPtr Ptr Workspace
space Ptr ()
_ = do
    Workspace
space' <- ((ManagedPtr Workspace -> Workspace)
-> Ptr Workspace -> IO Workspace
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Workspace -> Workspace
Wnck.Workspace.Workspace) Ptr Workspace
space
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> ScreenActiveWorkspaceChangedCallback
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self)  Workspace
space'


-- | Connect a signal handler for the [workspaceCreated](#signal:workspaceCreated) 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' screen #workspaceCreated callback
-- @
-- 
-- 
onScreenWorkspaceCreated :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWorkspaceCreatedCallback) -> m SignalHandlerId
onScreenWorkspaceCreated :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWorkspaceChangedCallback)
-> m SignalHandlerId
onScreenWorkspaceCreated a
obj (?self::a) => ScreenActiveWorkspaceChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWorkspaceChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWorkspaceChangedCallback
ScreenActiveWorkspaceChangedCallback
cb
    let wrapped' :: C_ScreenActiveWorkspaceChangedCallback
wrapped' = (a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
wrap_ScreenWorkspaceCreatedCallback a -> ScreenActiveWorkspaceChangedCallback
wrapped
    FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' <- C_ScreenActiveWorkspaceChangedCallback
-> IO (FunPtr C_ScreenActiveWorkspaceChangedCallback)
mk_ScreenWorkspaceCreatedCallback C_ScreenActiveWorkspaceChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWorkspaceChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"workspace-created" FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [workspaceCreated](#signal:workspaceCreated) 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' screen #workspaceCreated callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenWorkspaceCreated :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWorkspaceCreatedCallback) -> m SignalHandlerId
afterScreenWorkspaceCreated :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWorkspaceChangedCallback)
-> m SignalHandlerId
afterScreenWorkspaceCreated a
obj (?self::a) => ScreenActiveWorkspaceChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWorkspaceChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWorkspaceChangedCallback
ScreenActiveWorkspaceChangedCallback
cb
    let wrapped' :: C_ScreenActiveWorkspaceChangedCallback
wrapped' = (a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
wrap_ScreenWorkspaceCreatedCallback a -> ScreenActiveWorkspaceChangedCallback
wrapped
    FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' <- C_ScreenActiveWorkspaceChangedCallback
-> IO (FunPtr C_ScreenActiveWorkspaceChangedCallback)
mk_ScreenWorkspaceCreatedCallback C_ScreenActiveWorkspaceChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWorkspaceChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"workspace-created" FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenWorkspaceCreatedSignalInfo
instance SignalInfo ScreenWorkspaceCreatedSignalInfo where
    type HaskellCallbackType ScreenWorkspaceCreatedSignalInfo = ScreenWorkspaceCreatedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenWorkspaceCreatedCallback cb
        cb'' <- mk_ScreenWorkspaceCreatedCallback cb'
        connectSignalFunPtr obj "workspace-created" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::workspace-created"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:workspaceCreated"})

#endif

-- signal Screen::workspace-destroyed
-- | Emitted when a t'GI.Wnck.Objects.Workspace.Workspace' is destroyed on /@screen@/.
type ScreenWorkspaceDestroyedCallback =
    Wnck.Workspace.Workspace
    -- ^ /@space@/: the workspace that has been destroyed.
    -> IO ()

type C_ScreenWorkspaceDestroyedCallback =
    Ptr Screen ->                           -- object
    Ptr Wnck.Workspace.Workspace ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScreenWorkspaceDestroyedCallback :: 
    GObject a => (a -> ScreenWorkspaceDestroyedCallback) ->
    C_ScreenWorkspaceDestroyedCallback
wrap_ScreenWorkspaceDestroyedCallback :: forall a.
GObject a =>
(a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
wrap_ScreenWorkspaceDestroyedCallback a -> ScreenActiveWorkspaceChangedCallback
gi'cb Ptr Screen
gi'selfPtr Ptr Workspace
space Ptr ()
_ = do
    Workspace
space' <- ((ManagedPtr Workspace -> Workspace)
-> Ptr Workspace -> IO Workspace
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Workspace -> Workspace
Wnck.Workspace.Workspace) Ptr Workspace
space
    Ptr Screen -> (Screen -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Screen
gi'selfPtr ((Screen -> IO ()) -> IO ()) -> (Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Screen
gi'self -> a -> ScreenActiveWorkspaceChangedCallback
gi'cb (Screen -> a
Coerce.coerce Screen
gi'self)  Workspace
space'


-- | Connect a signal handler for the [workspaceDestroyed](#signal:workspaceDestroyed) 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' screen #workspaceDestroyed callback
-- @
-- 
-- 
onScreenWorkspaceDestroyed :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWorkspaceDestroyedCallback) -> m SignalHandlerId
onScreenWorkspaceDestroyed :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWorkspaceChangedCallback)
-> m SignalHandlerId
onScreenWorkspaceDestroyed a
obj (?self::a) => ScreenActiveWorkspaceChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWorkspaceChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWorkspaceChangedCallback
ScreenActiveWorkspaceChangedCallback
cb
    let wrapped' :: C_ScreenActiveWorkspaceChangedCallback
wrapped' = (a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
wrap_ScreenWorkspaceDestroyedCallback a -> ScreenActiveWorkspaceChangedCallback
wrapped
    FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' <- C_ScreenActiveWorkspaceChangedCallback
-> IO (FunPtr C_ScreenActiveWorkspaceChangedCallback)
mk_ScreenWorkspaceDestroyedCallback C_ScreenActiveWorkspaceChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWorkspaceChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"workspace-destroyed" FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [workspaceDestroyed](#signal:workspaceDestroyed) 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' screen #workspaceDestroyed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterScreenWorkspaceDestroyed :: (IsScreen a, MonadIO m) => a -> ((?self :: a) => ScreenWorkspaceDestroyedCallback) -> m SignalHandlerId
afterScreenWorkspaceDestroyed :: forall a (m :: * -> *).
(IsScreen a, MonadIO m) =>
a
-> ((?self::a) => ScreenActiveWorkspaceChangedCallback)
-> m SignalHandlerId
afterScreenWorkspaceDestroyed a
obj (?self::a) => ScreenActiveWorkspaceChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ScreenActiveWorkspaceChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScreenActiveWorkspaceChangedCallback
ScreenActiveWorkspaceChangedCallback
cb
    let wrapped' :: C_ScreenActiveWorkspaceChangedCallback
wrapped' = (a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
forall a.
GObject a =>
(a -> ScreenActiveWorkspaceChangedCallback)
-> C_ScreenActiveWorkspaceChangedCallback
wrap_ScreenWorkspaceDestroyedCallback a -> ScreenActiveWorkspaceChangedCallback
wrapped
    FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' <- C_ScreenActiveWorkspaceChangedCallback
-> IO (FunPtr C_ScreenActiveWorkspaceChangedCallback)
mk_ScreenWorkspaceDestroyedCallback C_ScreenActiveWorkspaceChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScreenActiveWorkspaceChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"workspace-destroyed" FunPtr C_ScreenActiveWorkspaceChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenWorkspaceDestroyedSignalInfo
instance SignalInfo ScreenWorkspaceDestroyedSignalInfo where
    type HaskellCallbackType ScreenWorkspaceDestroyedSignalInfo = ScreenWorkspaceDestroyedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenWorkspaceDestroyedCallback cb
        cb'' <- mk_ScreenWorkspaceDestroyedCallback cb'
        connectSignalFunPtr obj "workspace-destroyed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen::workspace-destroyed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#g:signal:workspaceDestroyed"})

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Screen
type instance O.AttributeList Screen = ScreenAttributeList
type ScreenAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Screen = ScreenSignalList
type ScreenSignalList = ('[ '("activeWindowChanged", ScreenActiveWindowChangedSignalInfo), '("activeWorkspaceChanged", ScreenActiveWorkspaceChangedSignalInfo), '("applicationClosed", ScreenApplicationClosedSignalInfo), '("applicationOpened", ScreenApplicationOpenedSignalInfo), '("backgroundChanged", ScreenBackgroundChangedSignalInfo), '("classGroupClosed", ScreenClassGroupClosedSignalInfo), '("classGroupOpened", ScreenClassGroupOpenedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("showingDesktopChanged", ScreenShowingDesktopChangedSignalInfo), '("viewportsChanged", ScreenViewportsChangedSignalInfo), '("windowClosed", ScreenWindowClosedSignalInfo), '("windowManagerChanged", ScreenWindowManagerChangedSignalInfo), '("windowOpened", ScreenWindowOpenedSignalInfo), '("windowStackingChanged", ScreenWindowStackingChangedSignalInfo), '("workspaceCreated", ScreenWorkspaceCreatedSignalInfo), '("workspaceDestroyed", ScreenWorkspaceDestroyedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Screen::calc_workspace_layout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "num_workspaces"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the number of #WnckWorkspace on @screen, or -1 to let\nwnck_screen_calc_workspace_layout() find this number."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "space_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of a #WnckWorkspace."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "WorkspaceLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the layout of #WnckWorkspace with additional\ninformation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_calc_workspace_layout" wnck_screen_calc_workspace_layout :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    Int32 ->                                -- num_workspaces : TBasicType TInt
    Int32 ->                                -- space_index : TBasicType TInt
    Ptr Wnck.WorkspaceLayout.WorkspaceLayout -> -- layout : TInterface (Name {namespace = "Wnck", name = "WorkspaceLayout"})
    IO ()

{-# DEPRECATED screenCalcWorkspaceLayout ["(Since version 2.20)"] #-}
-- | Calculates the layout of t'GI.Wnck.Objects.Workspace.Workspace', with additional information like
-- the row and column of the t'GI.Wnck.Objects.Workspace.Workspace' with index /@spaceIndex@/.
-- 
-- /Since: 2.12/
screenCalcWorkspaceLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> Int32
    -- ^ /@numWorkspaces@/: the number of t'GI.Wnck.Objects.Workspace.Workspace' on /@screen@/, or -1 to let
    -- 'GI.Wnck.Objects.Screen.screenCalcWorkspaceLayout' find this number.
    -> Int32
    -- ^ /@spaceIndex@/: the index of a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> Wnck.WorkspaceLayout.WorkspaceLayout
    -- ^ /@layout@/: return location for the layout of t'GI.Wnck.Objects.Workspace.Workspace' with additional
    -- information.
    -> m ()
screenCalcWorkspaceLayout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> Int32 -> Int32 -> WorkspaceLayout -> m ()
screenCalcWorkspaceLayout a
screen Int32
numWorkspaces Int32
spaceIndex WorkspaceLayout
layout = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr WorkspaceLayout
layout' <- WorkspaceLayout -> IO (Ptr WorkspaceLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WorkspaceLayout
layout
    Ptr Screen -> Int32 -> Int32 -> Ptr WorkspaceLayout -> IO ()
wnck_screen_calc_workspace_layout Ptr Screen
screen' Int32
numWorkspaces Int32
spaceIndex Ptr WorkspaceLayout
layout'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    WorkspaceLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WorkspaceLayout
layout
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScreenCalcWorkspaceLayoutMethodInfo
instance (signature ~ (Int32 -> Int32 -> Wnck.WorkspaceLayout.WorkspaceLayout -> m ()), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenCalcWorkspaceLayoutMethodInfo a signature where
    overloadedMethod = screenCalcWorkspaceLayout

instance O.OverloadedMethodInfo ScreenCalcWorkspaceLayoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenCalcWorkspaceLayout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenCalcWorkspaceLayout"
        })


#endif

-- method Screen::change_workspace_count
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of #WnckWorkspace to request."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_change_workspace_count" wnck_screen_change_workspace_count :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    Int32 ->                                -- count : TBasicType TInt
    IO ()

-- | Asks the window manager to change the number of t'GI.Wnck.Objects.Workspace.Workspace' on /@screen@/.
-- 
-- /Since: 2.2/
screenChangeWorkspaceCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> Int32
    -- ^ /@count@/: the number of t'GI.Wnck.Objects.Workspace.Workspace' to request.
    -> m ()
screenChangeWorkspaceCount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> Int32 -> m ()
screenChangeWorkspaceCount a
screen Int32
count = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Screen -> Int32 -> IO ()
wnck_screen_change_workspace_count Ptr Screen
screen' Int32
count
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScreenChangeWorkspaceCountMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenChangeWorkspaceCountMethodInfo a signature where
    overloadedMethod = screenChangeWorkspaceCount

instance O.OverloadedMethodInfo ScreenChangeWorkspaceCountMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenChangeWorkspaceCount",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenChangeWorkspaceCount"
        })


#endif

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

foreign import ccall "wnck_screen_force_update" wnck_screen_force_update :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO ()

-- | Synchronously and immediately updates the list of t'GI.Wnck.Objects.Window.Window' on /@screen@/.
-- This bypasses the standard update mechanism, where the list of t'GI.Wnck.Objects.Window.Window'
-- is updated in the idle loop.
-- 
-- This is usually a bad idea for both performance and correctness reasons (to
-- get things right, you need to write model-view code that tracks changes, not
-- get a static list of open windows). However, this function can be useful for
-- small applications that just do something and then exit.
screenForceUpdate ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m ()
screenForceUpdate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m ()
screenForceUpdate a
screen = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Screen -> IO ()
wnck_screen_force_update Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScreenForceUpdateMethodInfo
instance (signature ~ (m ()), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenForceUpdateMethodInfo a signature where
    overloadedMethod = screenForceUpdate

instance O.OverloadedMethodInfo ScreenForceUpdateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenForceUpdate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenForceUpdate"
        })


#endif

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

foreign import ccall "wnck_screen_get_active_window" wnck_screen_get_active_window :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO (Ptr Wnck.Window.Window)

-- | Gets the active t'GI.Wnck.Objects.Window.Window' on /@screen@/. May return 'P.Nothing' sometimes, since
-- not all window managers guarantee that a window is always active.
screenGetActiveWindow ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m (Maybe Wnck.Window.Window)
    -- ^ __Returns:__ the active t'GI.Wnck.Objects.Window.Window' on /@screen@/, or 'P.Nothing'.
    -- The returned t'GI.Wnck.Objects.Window.Window' is owned by libwnck and must not be referenced or
    -- unreferenced.
screenGetActiveWindow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m (Maybe Window)
screenGetActiveWindow a
screen = IO (Maybe Window) -> m (Maybe Window)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Window) -> m (Maybe Window))
-> IO (Maybe Window) -> m (Maybe Window)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Window
result <- Ptr Screen -> IO (Ptr Window)
wnck_screen_get_active_window Ptr Screen
screen'
    Maybe Window
maybeResult <- Ptr Window -> (Ptr Window -> IO Window) -> IO (Maybe Window)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Window
result ((Ptr Window -> IO Window) -> IO (Maybe Window))
-> (Ptr Window -> IO Window) -> IO (Maybe Window)
forall a b. (a -> b) -> a -> b
$ \Ptr Window
result' -> do
        Window
result'' <- ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Wnck.Window.Window) Ptr Window
result'
        Window -> IO Window
forall (m :: * -> *) a. Monad m => a -> m a
return Window
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Maybe Window -> IO (Maybe Window)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Window
maybeResult

#if defined(ENABLE_OVERLOADING)
data ScreenGetActiveWindowMethodInfo
instance (signature ~ (m (Maybe Wnck.Window.Window)), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetActiveWindowMethodInfo a signature where
    overloadedMethod = screenGetActiveWindow

instance O.OverloadedMethodInfo ScreenGetActiveWindowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetActiveWindow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetActiveWindow"
        })


#endif

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

foreign import ccall "wnck_screen_get_active_workspace" wnck_screen_get_active_workspace :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO (Ptr Wnck.Workspace.Workspace)

-- | Gets the active t'GI.Wnck.Objects.Workspace.Workspace' on /@screen@/. May return 'P.Nothing' sometimes,
-- if libwnck is in a weird state due to the asynchronous nature of the
-- interaction with the window manager.
screenGetActiveWorkspace ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m (Maybe Wnck.Workspace.Workspace)
    -- ^ __Returns:__ the active t'GI.Wnck.Objects.Workspace.Workspace' on /@screen@/, or
    -- 'P.Nothing'. The returned t'GI.Wnck.Objects.Workspace.Workspace' is owned by libwnck and must not be
    -- referenced or unreferenced.
screenGetActiveWorkspace :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m (Maybe Workspace)
screenGetActiveWorkspace a
screen = IO (Maybe Workspace) -> m (Maybe Workspace)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Workspace) -> m (Maybe Workspace))
-> IO (Maybe Workspace) -> m (Maybe Workspace)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Workspace
result <- Ptr Screen -> IO (Ptr Workspace)
wnck_screen_get_active_workspace Ptr Screen
screen'
    Maybe Workspace
maybeResult <- Ptr Workspace
-> (Ptr Workspace -> IO Workspace) -> IO (Maybe Workspace)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Workspace
result ((Ptr Workspace -> IO Workspace) -> IO (Maybe Workspace))
-> (Ptr Workspace -> IO Workspace) -> IO (Maybe Workspace)
forall a b. (a -> b) -> a -> b
$ \Ptr Workspace
result' -> do
        Workspace
result'' <- ((ManagedPtr Workspace -> Workspace)
-> Ptr Workspace -> IO Workspace
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Workspace -> Workspace
Wnck.Workspace.Workspace) Ptr Workspace
result'
        Workspace -> IO Workspace
forall (m :: * -> *) a. Monad m => a -> m a
return Workspace
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Maybe Workspace -> IO (Maybe Workspace)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Workspace
maybeResult

#if defined(ENABLE_OVERLOADING)
data ScreenGetActiveWorkspaceMethodInfo
instance (signature ~ (m (Maybe Wnck.Workspace.Workspace)), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetActiveWorkspaceMethodInfo a signature where
    overloadedMethod = screenGetActiveWorkspace

instance O.OverloadedMethodInfo ScreenGetActiveWorkspaceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetActiveWorkspace",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetActiveWorkspace"
        })


#endif

-- method Screen::get_background_pixmap
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , 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 "wnck_screen_get_background_pixmap" wnck_screen_get_background_pixmap :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO CULong

-- | Gets the X window ID of the background pixmap of /@screen@/.
screenGetBackgroundPixmap ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m CULong
    -- ^ __Returns:__ the X window ID of the background pixmap of /@screen@/.
screenGetBackgroundPixmap :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m SignalHandlerId
screenGetBackgroundPixmap a
screen = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    SignalHandlerId
result <- Ptr Screen -> IO SignalHandlerId
wnck_screen_get_background_pixmap Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    SignalHandlerId -> IO SignalHandlerId
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandlerId
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetBackgroundPixmapMethodInfo
instance (signature ~ (m CULong), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetBackgroundPixmapMethodInfo a signature where
    overloadedMethod = screenGetBackgroundPixmap

instance O.OverloadedMethodInfo ScreenGetBackgroundPixmapMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetBackgroundPixmap",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetBackgroundPixmap"
        })


#endif

-- method Screen::get_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , 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 "wnck_screen_get_height" wnck_screen_get_height :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO Int32

-- | Gets the height of /@screen@/.
screenGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m Int32
    -- ^ __Returns:__ the height of /@screen@/.
screenGetHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m Int32
screenGetHeight a
screen = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
wnck_screen_get_height Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetHeightMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetHeightMethodInfo a signature where
    overloadedMethod = screenGetHeight

instance O.OverloadedMethodInfo ScreenGetHeightMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetHeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetHeight"
        })


#endif

-- method Screen::get_number
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , 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 "wnck_screen_get_number" wnck_screen_get_number :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO Int32

-- | Gets the index of /@screen@/ on the display to which it belongs. The first
-- t'GI.Wnck.Objects.Screen.Screen' has an index of 0.
-- 
-- /Since: 2.20/
screenGetNumber ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m Int32
    -- ^ __Returns:__ the index of /@space@/ on /@screen@/, or -1 on errors.
screenGetNumber :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m Int32
screenGetNumber a
screen = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
wnck_screen_get_number Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetNumberMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetNumberMethodInfo a signature where
    overloadedMethod = screenGetNumber

instance O.OverloadedMethodInfo ScreenGetNumberMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetNumber",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetNumber"
        })


#endif

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

foreign import ccall "wnck_screen_get_previously_active_window" wnck_screen_get_previously_active_window :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO (Ptr Wnck.Window.Window)

-- | Gets the previously active t'GI.Wnck.Objects.Window.Window' on /@screen@/. May return 'P.Nothing'
-- sometimes, since not all window managers guarantee that a window is always
-- active.
-- 
-- /Since: 2.8/
screenGetPreviouslyActiveWindow ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m Wnck.Window.Window
    -- ^ __Returns:__ the previously active t'GI.Wnck.Objects.Window.Window' on /@screen@/,
    -- or 'P.Nothing'. The returned t'GI.Wnck.Objects.Window.Window' is owned by libwnck and must not be
    -- referenced or unreferenced.
screenGetPreviouslyActiveWindow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m Window
screenGetPreviouslyActiveWindow a
screen = IO Window -> m Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Window -> m Window) -> IO Window -> m Window
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Window
result <- Ptr Screen -> IO (Ptr Window)
wnck_screen_get_previously_active_window Ptr Screen
screen'
    Text -> Ptr Window -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"screenGetPreviouslyActiveWindow" Ptr Window
result
    Window
result' <- ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Wnck.Window.Window) Ptr Window
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Window -> IO Window
forall (m :: * -> *) a. Monad m => a -> m a
return Window
result'

#if defined(ENABLE_OVERLOADING)
data ScreenGetPreviouslyActiveWindowMethodInfo
instance (signature ~ (m Wnck.Window.Window), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetPreviouslyActiveWindowMethodInfo a signature where
    overloadedMethod = screenGetPreviouslyActiveWindow

instance O.OverloadedMethodInfo ScreenGetPreviouslyActiveWindowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetPreviouslyActiveWindow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetPreviouslyActiveWindow"
        })


#endif

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

foreign import ccall "wnck_screen_get_showing_desktop" wnck_screen_get_showing_desktop :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO CInt

-- | Gets whether /@screen@/ is in the \"showing the desktop\" mode. This mode is
-- changed when a [showingDesktopChanged]("GI.Wnck.Objects.Screen#g:signal:showingDesktopChanged") signal gets emitted.
-- 
-- /Since: 2.2/
screenGetShowingDesktop ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@window@/ is fullscreen, 'P.False' otherwise.
screenGetShowingDesktop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m Bool
screenGetShowingDesktop a
screen = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    CInt
result <- Ptr Screen -> IO CInt
wnck_screen_get_showing_desktop Ptr Screen
screen'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ScreenGetShowingDesktopMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetShowingDesktopMethodInfo a signature where
    overloadedMethod = screenGetShowingDesktop

instance O.OverloadedMethodInfo ScreenGetShowingDesktopMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetShowingDesktop",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetShowingDesktop"
        })


#endif

-- method Screen::get_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , 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 "wnck_screen_get_width" wnck_screen_get_width :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO Int32

-- | Gets the width of /@screen@/.
screenGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m Int32
    -- ^ __Returns:__ the width of /@screen@/.
screenGetWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m Int32
screenGetWidth a
screen = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
wnck_screen_get_width Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetWidthMethodInfo a signature where
    overloadedMethod = screenGetWidth

instance O.OverloadedMethodInfo ScreenGetWidthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetWidth"
        })


#endif

-- method Screen::get_window_manager_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , 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 "wnck_screen_get_window_manager_name" wnck_screen_get_window_manager_name :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO CString

-- | Gets the name of the window manager.
-- 
-- /Since: 2.20/
screenGetWindowManagerName ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m T.Text
    -- ^ __Returns:__ the name of the window manager, or 'P.Nothing' if the window manager
    -- does not comply with the \<ulink
    -- url=\"http:\/\/standards.freedesktop.org\/wm-spec\/wm-spec-latest.html\">EWMH\<\/ulink>
    -- specification.
screenGetWindowManagerName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m Text
screenGetWindowManagerName a
screen = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    CString
result <- Ptr Screen -> IO CString
wnck_screen_get_window_manager_name Ptr Screen
screen'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"screenGetWindowManagerName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ScreenGetWindowManagerNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetWindowManagerNameMethodInfo a signature where
    overloadedMethod = screenGetWindowManagerName

instance O.OverloadedMethodInfo ScreenGetWindowManagerNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetWindowManagerName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetWindowManagerName"
        })


#endif

-- method Screen::get_windows
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Wnck" , name = "Window" }))
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_get_windows" wnck_screen_get_windows :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO (Ptr (GList (Ptr Wnck.Window.Window)))

-- | Gets the list of t'GI.Wnck.Objects.Window.Window' on /@screen@/. The list is not in a defined
-- order, but should be \"stable\" (windows should not be reordered in it).
-- However, the stability of the list is established by the window manager, so
-- don\'t blame libwnck if it breaks down.
screenGetWindows ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m [Wnck.Window.Window]
    -- ^ __Returns:__ the list of
    -- t'GI.Wnck.Objects.Window.Window' on /@screen@/, or 'P.Nothing' if there is no window on /@screen@/. The list
    -- should not be modified nor freed, as it is owned by /@screen@/.
screenGetWindows :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m [Window]
screenGetWindows a
screen = IO [Window] -> m [Window]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Window] -> m [Window]) -> IO [Window] -> m [Window]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr (GList (Ptr Window))
result <- Ptr Screen -> IO (Ptr (GList (Ptr Window)))
wnck_screen_get_windows Ptr Screen
screen'
    [Ptr Window]
result' <- Ptr (GList (Ptr Window)) -> IO [Ptr Window]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Window))
result
    [Window]
result'' <- (Ptr Window -> IO Window) -> [Ptr Window] -> IO [Window]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Wnck.Window.Window) [Ptr Window]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    [Window] -> IO [Window]
forall (m :: * -> *) a. Monad m => a -> m a
return [Window]
result''

#if defined(ENABLE_OVERLOADING)
data ScreenGetWindowsMethodInfo
instance (signature ~ (m [Wnck.Window.Window]), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetWindowsMethodInfo a signature where
    overloadedMethod = screenGetWindows

instance O.OverloadedMethodInfo ScreenGetWindowsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetWindows",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetWindows"
        })


#endif

-- method Screen::get_windows_stacked
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Wnck" , name = "Window" }))
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_get_windows_stacked" wnck_screen_get_windows_stacked :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO (Ptr (GList (Ptr Wnck.Window.Window)))

-- | Gets the list of t'GI.Wnck.Objects.Window.Window' on /@screen@/ in bottom-to-top order.
screenGetWindowsStacked ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m [Wnck.Window.Window]
    -- ^ __Returns:__ the list of
    -- t'GI.Wnck.Objects.Window.Window' in stacking order on /@screen@/, or 'P.Nothing' if there is no window on
    -- /@screen@/. The list should not be modified nor freed, as it is owned by
    -- /@screen@/.
screenGetWindowsStacked :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m [Window]
screenGetWindowsStacked a
screen = IO [Window] -> m [Window]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Window] -> m [Window]) -> IO [Window] -> m [Window]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr (GList (Ptr Window))
result <- Ptr Screen -> IO (Ptr (GList (Ptr Window)))
wnck_screen_get_windows_stacked Ptr Screen
screen'
    [Ptr Window]
result' <- Ptr (GList (Ptr Window)) -> IO [Ptr Window]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Window))
result
    [Window]
result'' <- (Ptr Window -> IO Window) -> [Ptr Window] -> IO [Window]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Wnck.Window.Window) [Ptr Window]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    [Window] -> IO [Window]
forall (m :: * -> *) a. Monad m => a -> m a
return [Window]
result''

#if defined(ENABLE_OVERLOADING)
data ScreenGetWindowsStackedMethodInfo
instance (signature ~ (m [Wnck.Window.Window]), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetWindowsStackedMethodInfo a signature where
    overloadedMethod = screenGetWindowsStacked

instance O.OverloadedMethodInfo ScreenGetWindowsStackedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetWindowsStacked",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetWindowsStacked"
        })


#endif

-- method Screen::get_workspace
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "workspace"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a workspace index, starting from 0."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Wnck" , name = "Workspace" })
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_get_workspace" wnck_screen_get_workspace :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    Int32 ->                                -- workspace : TBasicType TInt
    IO (Ptr Wnck.Workspace.Workspace)

-- | Gets the t'GI.Wnck.Objects.Workspace.Workspace' numbered /@workspace@/ on /@screen@/.
screenGetWorkspace ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> Int32
    -- ^ /@workspace@/: a workspace index, starting from 0.
    -> m Wnck.Workspace.Workspace
    -- ^ __Returns:__ the t'GI.Wnck.Objects.Workspace.Workspace' numbered /@workspace@/ on
    -- /@screen@/, or 'P.Nothing' if no such workspace exists. The returned t'GI.Wnck.Objects.Workspace.Workspace'
    -- is owned by libwnck and must not be referenced or unreferenced.
screenGetWorkspace :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> Int32 -> m Workspace
screenGetWorkspace a
screen Int32
workspace = IO Workspace -> m Workspace
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Workspace -> m Workspace) -> IO Workspace -> m Workspace
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Workspace
result <- Ptr Screen -> Int32 -> IO (Ptr Workspace)
wnck_screen_get_workspace Ptr Screen
screen' Int32
workspace
    Text -> Ptr Workspace -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"screenGetWorkspace" Ptr Workspace
result
    Workspace
result' <- ((ManagedPtr Workspace -> Workspace)
-> Ptr Workspace -> IO Workspace
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Workspace -> Workspace
Wnck.Workspace.Workspace) Ptr Workspace
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Workspace -> IO Workspace
forall (m :: * -> *) a. Monad m => a -> m a
return Workspace
result'

#if defined(ENABLE_OVERLOADING)
data ScreenGetWorkspaceMethodInfo
instance (signature ~ (Int32 -> m Wnck.Workspace.Workspace), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetWorkspaceMethodInfo a signature where
    overloadedMethod = screenGetWorkspace

instance O.OverloadedMethodInfo ScreenGetWorkspaceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetWorkspace",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetWorkspace"
        })


#endif

-- method Screen::get_workspace_count
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , 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 "wnck_screen_get_workspace_count" wnck_screen_get_workspace_count :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO Int32

-- | Gets the number of t'GI.Wnck.Objects.Workspace.Workspace' on /@screen@/.
screenGetWorkspaceCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m Int32
    -- ^ __Returns:__ the number of t'GI.Wnck.Objects.Workspace.Workspace' on /@screen@/.
screenGetWorkspaceCount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m Int32
screenGetWorkspaceCount a
screen = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
wnck_screen_get_workspace_count Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetWorkspaceCountMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetWorkspaceCountMethodInfo a signature where
    overloadedMethod = screenGetWorkspaceCount

instance O.OverloadedMethodInfo ScreenGetWorkspaceCountMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetWorkspaceCount",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetWorkspaceCount"
        })


#endif

-- method Screen::get_workspaces
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Wnck" , name = "Workspace" }))
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_get_workspaces" wnck_screen_get_workspaces :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    IO (Ptr (GList (Ptr Wnck.Workspace.Workspace)))

-- | Gets the list of t'GI.Wnck.Objects.Workspace.Workspace' on /@screen@/. The list is ordered: the
-- first element in the list is the first t'GI.Wnck.Objects.Workspace.Workspace', etc..
-- 
-- /Since: 2.20/
screenGetWorkspaces ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> m [Wnck.Workspace.Workspace]
    -- ^ __Returns:__ the list of
    -- t'GI.Wnck.Objects.Workspace.Workspace' on /@screen@/. The list should not be modified nor freed, as it
    -- is owned by /@screen@/.
screenGetWorkspaces :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m [Workspace]
screenGetWorkspaces a
screen = IO [Workspace] -> m [Workspace]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Workspace] -> m [Workspace])
-> IO [Workspace] -> m [Workspace]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr (GList (Ptr Workspace))
result <- Ptr Screen -> IO (Ptr (GList (Ptr Workspace)))
wnck_screen_get_workspaces Ptr Screen
screen'
    [Ptr Workspace]
result' <- Ptr (GList (Ptr Workspace)) -> IO [Ptr Workspace]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Workspace))
result
    [Workspace]
result'' <- (Ptr Workspace -> IO Workspace)
-> [Ptr Workspace] -> IO [Workspace]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Workspace -> Workspace)
-> Ptr Workspace -> IO Workspace
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Workspace -> Workspace
Wnck.Workspace.Workspace) [Ptr Workspace]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    [Workspace] -> IO [Workspace]
forall (m :: * -> *) a. Monad m => a -> m a
return [Workspace]
result''

#if defined(ENABLE_OVERLOADING)
data ScreenGetWorkspacesMethodInfo
instance (signature ~ (m [Wnck.Workspace.Workspace]), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenGetWorkspacesMethodInfo a signature where
    overloadedMethod = screenGetWorkspaces

instance O.OverloadedMethodInfo ScreenGetWorkspacesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenGetWorkspaces",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenGetWorkspaces"
        })


#endif

-- method Screen::move_viewport
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X offset in pixels of viewport."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y offset in pixels of viewport."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_move_viewport" wnck_screen_move_viewport :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO ()

-- | Asks the window manager to move the viewport of the current t'GI.Wnck.Objects.Workspace.Workspace'
-- on /@screen@/.
-- 
-- /Since: 2.4/
screenMoveViewport ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> Int32
    -- ^ /@x@/: X offset in pixels of viewport.
    -> Int32
    -- ^ /@y@/: Y offset in pixels of viewport.
    -> m ()
screenMoveViewport :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> Int32 -> Int32 -> m ()
screenMoveViewport a
screen Int32
x Int32
y = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Screen -> Int32 -> Int32 -> IO ()
wnck_screen_move_viewport Ptr Screen
screen' Int32
x Int32
y
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScreenMoveViewportMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenMoveViewportMethodInfo a signature where
    overloadedMethod = screenMoveViewport

instance O.OverloadedMethodInfo ScreenMoveViewportMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenMoveViewport",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenMoveViewport"
        })


#endif

-- method Screen::net_wm_supports
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "atom"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a property atom." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_net_wm_supports" wnck_screen_net_wm_supports :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    CString ->                              -- atom : TBasicType TUTF8
    IO CInt

-- | Gets whether the window manager for /@screen@/ supports a certain hint from
-- the \<ulink
-- url=\"http:\/\/standards.freedesktop.org\/wm-spec\/wm-spec-latest.html\">Extended
-- Window Manager Hints specification\<\/ulink> (EWMH).
-- 
-- When using this function, keep in mind that the window manager can change
-- over time; so you should not use this function in a way that impacts
-- persistent application state. A common bug is that your application can
-- start up before the window manager does when the user logs in, and before
-- the window manager starts 'GI.Wnck.Objects.Screen.screenNetWmSupports' will return 'P.False'
-- for every property.
-- 
-- See also @/gdk_x11_screen_supports_net_wm_hint()/@ in GDK.
screenNetWmSupports ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> T.Text
    -- ^ /@atom@/: a property atom.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the window manager for /@screen@/ supports the /@atom@/
    -- hint, 'P.False' otherwise.
screenNetWmSupports :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> Text -> m Bool
screenNetWmSupports a
screen Text
atom = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    CString
atom' <- Text -> IO CString
textToCString Text
atom
    CInt
result <- Ptr Screen -> CString -> IO CInt
wnck_screen_net_wm_supports Ptr Screen
screen' CString
atom'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
atom'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ScreenNetWmSupportsMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenNetWmSupportsMethodInfo a signature where
    overloadedMethod = screenNetWmSupports

instance O.OverloadedMethodInfo ScreenNetWmSupportsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenNetWmSupports",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenNetWmSupports"
        })


#endif

-- method Screen::release_workspace_layout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "current_token"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the token obtained through\nwnck_screen_try_set_workspace_layout()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_release_workspace_layout" wnck_screen_release_workspace_layout :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    Int32 ->                                -- current_token : TBasicType TInt
    IO ()

-- | Releases the ownership of the layout of t'GI.Wnck.Objects.Workspace.Workspace' on /@screen@/.
-- /@currentToken@/ is used to verify that the caller is the owner of the layout.
-- If the verification fails, nothing happens.
screenReleaseWorkspaceLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> Int32
    -- ^ /@currentToken@/: the token obtained through
    -- 'GI.Wnck.Objects.Screen.screenTrySetWorkspaceLayout'.
    -> m ()
screenReleaseWorkspaceLayout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> Int32 -> m ()
screenReleaseWorkspaceLayout a
screen Int32
currentToken = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Screen -> Int32 -> IO ()
wnck_screen_release_workspace_layout Ptr Screen
screen' Int32
currentToken
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScreenReleaseWorkspaceLayoutMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenReleaseWorkspaceLayoutMethodInfo a signature where
    overloadedMethod = screenReleaseWorkspaceLayout

instance O.OverloadedMethodInfo ScreenReleaseWorkspaceLayoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenReleaseWorkspaceLayout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenReleaseWorkspaceLayout"
        })


#endif

-- method Screen::toggle_showing_desktop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "show"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether to activate the \"showing the desktop\" mode on @screen."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_toggle_showing_desktop" wnck_screen_toggle_showing_desktop :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    CInt ->                                 -- show : TBasicType TBoolean
    IO ()

-- | Asks the window manager to set the \"showing the desktop\" mode on /@screen@/
-- according to /@show@/.
-- 
-- /Since: 2.2/
screenToggleShowingDesktop ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> Bool
    -- ^ /@show@/: whether to activate the \"showing the desktop\" mode on /@screen@/.
    -> m ()
screenToggleShowingDesktop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> Bool -> m ()
screenToggleShowingDesktop a
screen Bool
show_ = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    let show_' :: CInt
show_' = (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
show_
    Ptr Screen -> CInt -> IO ()
wnck_screen_toggle_showing_desktop Ptr Screen
screen' CInt
show_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScreenToggleShowingDesktopMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenToggleShowingDesktopMethodInfo a signature where
    overloadedMethod = screenToggleShowingDesktop

instance O.OverloadedMethodInfo ScreenToggleShowingDesktopMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenToggleShowingDesktop",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenToggleShowingDesktop"
        })


#endif

-- method Screen::try_set_workspace_layout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "current_token"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a token. Use 0 if you do not called\nwnck_screen_try_set_workspace_layout() before, or if you did not keep the\nold token."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rows"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the number of rows to use for the #WnckWorkspace layout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "columns"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the number of columns to use for the #WnckWorkspace layout."
--                 , 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 "wnck_screen_try_set_workspace_layout" wnck_screen_try_set_workspace_layout :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Wnck", name = "Screen"})
    Int32 ->                                -- current_token : TBasicType TInt
    Int32 ->                                -- rows : TBasicType TInt
    Int32 ->                                -- columns : TBasicType TInt
    IO Int32

-- | Tries to modify the layout of t'GI.Wnck.Objects.Workspace.Workspace' on /@screen@/. To do this, tries
-- to acquire ownership of the layout. If the current process is the owner of
-- the layout, /@currentToken@/ is used to determine if the caller is the owner
-- (there might be more than one part of the same process trying to set the
-- layout). Since no more than one application should set this property of
-- /@screen@/ at a time, setting the layout is not guaranteed to work.
-- 
-- If /@rows@/ is 0, the actual number of rows will be determined based on
-- /@columns@/ and the number of t'GI.Wnck.Objects.Workspace.Workspace'. If /@columns@/ is 0, the actual
-- number of columns will be determined based on /@rows@/ and the number of
-- t'GI.Wnck.Objects.Workspace.Workspace'. /@rows@/ and /@columns@/ must not be 0 at the same time.
-- 
-- You have to release the ownership of the layout with
-- 'GI.Wnck.Objects.Screen.screenReleaseWorkspaceLayout' when you do not need it anymore.
screenTrySetWorkspaceLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Wnck.Objects.Screen.Screen'.
    -> Int32
    -- ^ /@currentToken@/: a token. Use 0 if you do not called
    -- 'GI.Wnck.Objects.Screen.screenTrySetWorkspaceLayout' before, or if you did not keep the
    -- old token.
    -> Int32
    -- ^ /@rows@/: the number of rows to use for the t'GI.Wnck.Objects.Workspace.Workspace' layout.
    -> Int32
    -- ^ /@columns@/: the number of columns to use for the t'GI.Wnck.Objects.Workspace.Workspace' layout.
    -> m Int32
    -- ^ __Returns:__ a token to use for future calls to
    -- 'GI.Wnck.Objects.Screen.screenTrySetWorkspaceLayout' and to
    -- 'GI.Wnck.Objects.Screen.screenReleaseWorkspaceLayout', or 0 if the layout could not be set.
screenTrySetWorkspaceLayout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> Int32 -> Int32 -> Int32 -> m Int32
screenTrySetWorkspaceLayout a
screen Int32
currentToken Int32
rows Int32
columns = 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 Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> Int32 -> Int32 -> Int32 -> IO Int32
wnck_screen_try_set_workspace_layout Ptr Screen
screen' Int32
currentToken Int32
rows Int32
columns
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenTrySetWorkspaceLayoutMethodInfo
instance (signature ~ (Int32 -> Int32 -> Int32 -> m Int32), MonadIO m, IsScreen a) => O.OverloadedMethod ScreenTrySetWorkspaceLayoutMethodInfo a signature where
    overloadedMethod = screenTrySetWorkspaceLayout

instance O.OverloadedMethodInfo ScreenTrySetWorkspaceLayoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Wnck.Objects.Screen.screenTrySetWorkspaceLayout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-wnck-3.0.11/docs/GI-Wnck-Objects-Screen.html#v:screenTrySetWorkspaceLayout"
        })


#endif

-- method Screen::free_workspace_layout
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "WorkspaceLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspaceLayout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_free_workspace_layout" wnck_screen_free_workspace_layout :: 
    Ptr Wnck.WorkspaceLayout.WorkspaceLayout -> -- layout : TInterface (Name {namespace = "Wnck", name = "WorkspaceLayout"})
    IO ()

{-# DEPRECATED screenFreeWorkspaceLayout ["(Since version 2.20)"] #-}
-- | Frees the content of /@layout@/. This does not free /@layout@/ itself, so you
-- might want to free /@layout@/ yourself after calling this.
-- 
-- /Since: 2.12/
screenFreeWorkspaceLayout ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Wnck.WorkspaceLayout.WorkspaceLayout
    -- ^ /@layout@/: a t'GI.Wnck.Structs.WorkspaceLayout.WorkspaceLayout'.
    -> m ()
screenFreeWorkspaceLayout :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WorkspaceLayout -> m ()
screenFreeWorkspaceLayout WorkspaceLayout
layout = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr WorkspaceLayout
layout' <- WorkspaceLayout -> IO (Ptr WorkspaceLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WorkspaceLayout
layout
    Ptr WorkspaceLayout -> IO ()
wnck_screen_free_workspace_layout Ptr WorkspaceLayout
layout'
    WorkspaceLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WorkspaceLayout
layout
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Screen::get
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "screen number, starting from 0."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Wnck" , name = "Screen" })
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_get" wnck_screen_get :: 
    Int32 ->                                -- index : TBasicType TInt
    IO (Ptr Screen)

-- | Gets the t'GI.Wnck.Objects.Screen.Screen' for a given screen on the default display.
screenGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@index@/: screen number, starting from 0.
    -> m Screen
    -- ^ __Returns:__ the t'GI.Wnck.Objects.Screen.Screen' for screen /@index@/, or 'P.Nothing'
    -- if no such screen exists. The returned t'GI.Wnck.Objects.Screen.Screen' is owned by libwnck and
    -- must not be referenced or unreferenced.
screenGet :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> m Screen
screenGet Int32
index = 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 Screen
result <- Int32 -> IO (Ptr Screen)
wnck_screen_get Int32
index
    Text -> Ptr Screen -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"screenGet" Ptr Screen
result
    Screen
result' <- ((ManagedPtr Screen -> Screen) -> Ptr Screen -> IO Screen
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Screen -> Screen
Screen) Ptr Screen
result
    Screen -> IO Screen
forall (m :: * -> *) a. Monad m => a -> m a
return Screen
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Screen::get_default
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Wnck" , name = "Screen" })
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_get_default" wnck_screen_get_default :: 
    IO (Ptr Screen)

-- | Gets the default t'GI.Wnck.Objects.Screen.Screen' on the default display.
screenGetDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m (Maybe Screen)
    -- ^ __Returns:__ the default t'GI.Wnck.Objects.Screen.Screen'. The returned
    -- t'GI.Wnck.Objects.Screen.Screen' is owned by libwnck and must not be referenced or unreferenced. This
    -- can return 'P.Nothing' if not on X11.
screenGetDefault :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m (Maybe Screen)
screenGetDefault  = IO (Maybe Screen) -> m (Maybe Screen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Screen) -> m (Maybe Screen))
-> IO (Maybe Screen) -> m (Maybe Screen)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
result <- IO (Ptr Screen)
wnck_screen_get_default
    Maybe Screen
maybeResult <- Ptr Screen -> (Ptr Screen -> IO Screen) -> IO (Maybe Screen)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Screen
result ((Ptr Screen -> IO Screen) -> IO (Maybe Screen))
-> (Ptr Screen -> IO Screen) -> IO (Maybe Screen)
forall a b. (a -> b) -> a -> b
$ \Ptr Screen
result' -> do
        Screen
result'' <- ((ManagedPtr Screen -> Screen) -> Ptr Screen -> IO Screen
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Screen -> Screen
Screen) Ptr Screen
result'
        Screen -> IO Screen
forall (m :: * -> *) a. Monad m => a -> m a
return Screen
result''
    Maybe Screen -> IO (Maybe Screen)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Screen
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Screen::get_for_root
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "root_window_id"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an X window ID." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Wnck" , name = "Screen" })
-- throws : False
-- Skip return : False

foreign import ccall "wnck_screen_get_for_root" wnck_screen_get_for_root :: 
    CULong ->                               -- root_window_id : TBasicType TULong
    IO (Ptr Screen)

-- | Gets the t'GI.Wnck.Objects.Screen.Screen' for the root window at /@rootWindowId@/, or
-- 'P.Nothing' if no t'GI.Wnck.Objects.Screen.Screen' exists for this root window.
-- 
-- This function does not work if 'GI.Wnck.Objects.Screen.screenGet' was not called for the
-- sought t'GI.Wnck.Objects.Screen.Screen' before, and returns 'P.Nothing'.
screenGetForRoot ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CULong
    -- ^ /@rootWindowId@/: an X window ID.
    -> m Screen
    -- ^ __Returns:__ the t'GI.Wnck.Objects.Screen.Screen' for the root window at
    -- /@rootWindowId@/, or 'P.Nothing'. The returned t'GI.Wnck.Objects.Screen.Screen' is owned by libwnck and
    -- must not be referenced or unreferenced.
screenGetForRoot :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SignalHandlerId -> m Screen
screenGetForRoot SignalHandlerId
rootWindowId = 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 Screen
result <- SignalHandlerId -> IO (Ptr Screen)
wnck_screen_get_for_root SignalHandlerId
rootWindowId
    Text -> Ptr Screen -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"screenGetForRoot" Ptr Screen
result
    Screen
result' <- ((ManagedPtr Screen -> Screen) -> Ptr Screen -> IO Screen
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Screen -> Screen
Screen) Ptr Screen
result
    Screen -> IO Screen
forall (m :: * -> *) a. Monad m => a -> m a
return Screen
result'

#if defined(ENABLE_OVERLOADING)
#endif