{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Wnck.Objects.Workspace.Workspace' 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.Workspace
    ( 

-- * Exported types
    Workspace(..)                           ,
    IsWorkspace                             ,
    toWorkspace                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveWorkspaceMethod                  ,
#endif


-- ** activate #method:activate#

#if defined(ENABLE_OVERLOADING)
    WorkspaceActivateMethodInfo             ,
#endif
    workspaceActivate                       ,


-- ** changeName #method:changeName#

#if defined(ENABLE_OVERLOADING)
    WorkspaceChangeNameMethodInfo           ,
#endif
    workspaceChangeName                     ,


-- ** getHeight #method:getHeight#

#if defined(ENABLE_OVERLOADING)
    WorkspaceGetHeightMethodInfo            ,
#endif
    workspaceGetHeight                      ,


-- ** getLayoutColumn #method:getLayoutColumn#

#if defined(ENABLE_OVERLOADING)
    WorkspaceGetLayoutColumnMethodInfo      ,
#endif
    workspaceGetLayoutColumn                ,


-- ** getLayoutRow #method:getLayoutRow#

#if defined(ENABLE_OVERLOADING)
    WorkspaceGetLayoutRowMethodInfo         ,
#endif
    workspaceGetLayoutRow                   ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    WorkspaceGetNameMethodInfo              ,
#endif
    workspaceGetName                        ,


-- ** getNeighbor #method:getNeighbor#

#if defined(ENABLE_OVERLOADING)
    WorkspaceGetNeighborMethodInfo          ,
#endif
    workspaceGetNeighbor                    ,


-- ** getNumber #method:getNumber#

#if defined(ENABLE_OVERLOADING)
    WorkspaceGetNumberMethodInfo            ,
#endif
    workspaceGetNumber                      ,


-- ** getScreen #method:getScreen#

#if defined(ENABLE_OVERLOADING)
    WorkspaceGetScreenMethodInfo            ,
#endif
    workspaceGetScreen                      ,


-- ** getViewportX #method:getViewportX#

#if defined(ENABLE_OVERLOADING)
    WorkspaceGetViewportXMethodInfo         ,
#endif
    workspaceGetViewportX                   ,


-- ** getViewportY #method:getViewportY#

#if defined(ENABLE_OVERLOADING)
    WorkspaceGetViewportYMethodInfo         ,
#endif
    workspaceGetViewportY                   ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    WorkspaceGetWidthMethodInfo             ,
#endif
    workspaceGetWidth                       ,


-- ** isVirtual #method:isVirtual#

#if defined(ENABLE_OVERLOADING)
    WorkspaceIsVirtualMethodInfo            ,
#endif
    workspaceIsVirtual                      ,




 -- * Signals
-- ** nameChanged #signal:nameChanged#

    C_WorkspaceNameChangedCallback          ,
    WorkspaceNameChangedCallback            ,
#if defined(ENABLE_OVERLOADING)
    WorkspaceNameChangedSignalInfo          ,
#endif
    afterWorkspaceNameChanged               ,
    genClosure_WorkspaceNameChanged         ,
    mk_WorkspaceNameChangedCallback         ,
    noWorkspaceNameChangedCallback          ,
    onWorkspaceNameChanged                  ,
    wrap_WorkspaceNameChangedCallback       ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Wnck.Enums as Wnck.Enums
import {-# SOURCE #-} qualified GI.Wnck.Objects.Screen as Wnck.Screen

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

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

foreign import ccall "wnck_workspace_get_type"
    c_wnck_workspace_get_type :: IO B.Types.GType

instance B.Types.TypedObject Workspace where
    glibType :: IO GType
glibType = IO GType
c_wnck_workspace_get_type

instance B.Types.GObject Workspace

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveWorkspaceMethod (t :: Symbol) (o :: *) :: * where
    ResolveWorkspaceMethod "activate" o = WorkspaceActivateMethodInfo
    ResolveWorkspaceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveWorkspaceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveWorkspaceMethod "changeName" o = WorkspaceChangeNameMethodInfo
    ResolveWorkspaceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveWorkspaceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveWorkspaceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveWorkspaceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveWorkspaceMethod "isVirtual" o = WorkspaceIsVirtualMethodInfo
    ResolveWorkspaceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveWorkspaceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveWorkspaceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveWorkspaceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveWorkspaceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveWorkspaceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveWorkspaceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveWorkspaceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveWorkspaceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveWorkspaceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveWorkspaceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveWorkspaceMethod "getHeight" o = WorkspaceGetHeightMethodInfo
    ResolveWorkspaceMethod "getLayoutColumn" o = WorkspaceGetLayoutColumnMethodInfo
    ResolveWorkspaceMethod "getLayoutRow" o = WorkspaceGetLayoutRowMethodInfo
    ResolveWorkspaceMethod "getName" o = WorkspaceGetNameMethodInfo
    ResolveWorkspaceMethod "getNeighbor" o = WorkspaceGetNeighborMethodInfo
    ResolveWorkspaceMethod "getNumber" o = WorkspaceGetNumberMethodInfo
    ResolveWorkspaceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveWorkspaceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveWorkspaceMethod "getScreen" o = WorkspaceGetScreenMethodInfo
    ResolveWorkspaceMethod "getViewportX" o = WorkspaceGetViewportXMethodInfo
    ResolveWorkspaceMethod "getViewportY" o = WorkspaceGetViewportYMethodInfo
    ResolveWorkspaceMethod "getWidth" o = WorkspaceGetWidthMethodInfo
    ResolveWorkspaceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveWorkspaceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveWorkspaceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveWorkspaceMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Workspace::name-changed
-- | Emitted when the name of /@space@/ changes.
type WorkspaceNameChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `WorkspaceNameChangedCallback`@.
noWorkspaceNameChangedCallback :: Maybe WorkspaceNameChangedCallback
noWorkspaceNameChangedCallback :: Maybe (IO ())
noWorkspaceNameChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_WorkspaceNameChanged :: MonadIO m => WorkspaceNameChangedCallback -> m (GClosure C_WorkspaceNameChangedCallback)
genClosure_WorkspaceNameChanged :: IO () -> m (GClosure C_WorkspaceNameChangedCallback)
genClosure_WorkspaceNameChanged IO ()
cb = IO (GClosure C_WorkspaceNameChangedCallback)
-> m (GClosure C_WorkspaceNameChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_WorkspaceNameChangedCallback)
 -> m (GClosure C_WorkspaceNameChangedCallback))
-> IO (GClosure C_WorkspaceNameChangedCallback)
-> m (GClosure C_WorkspaceNameChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WorkspaceNameChangedCallback
cb' = IO () -> C_WorkspaceNameChangedCallback
wrap_WorkspaceNameChangedCallback IO ()
cb
    C_WorkspaceNameChangedCallback
-> IO (FunPtr C_WorkspaceNameChangedCallback)
mk_WorkspaceNameChangedCallback C_WorkspaceNameChangedCallback
cb' IO (FunPtr C_WorkspaceNameChangedCallback)
-> (FunPtr C_WorkspaceNameChangedCallback
    -> IO (GClosure C_WorkspaceNameChangedCallback))
-> IO (GClosure C_WorkspaceNameChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_WorkspaceNameChangedCallback
-> IO (GClosure C_WorkspaceNameChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `WorkspaceNameChangedCallback` into a `C_WorkspaceNameChangedCallback`.
wrap_WorkspaceNameChangedCallback ::
    WorkspaceNameChangedCallback ->
    C_WorkspaceNameChangedCallback
wrap_WorkspaceNameChangedCallback :: IO () -> C_WorkspaceNameChangedCallback
wrap_WorkspaceNameChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [nameChanged](#signal:nameChanged) 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' workspace #nameChanged callback
-- @
-- 
-- 
onWorkspaceNameChanged :: (IsWorkspace a, MonadIO m) => a -> WorkspaceNameChangedCallback -> m SignalHandlerId
onWorkspaceNameChanged :: a -> IO () -> m SignalHandlerId
onWorkspaceNameChanged a
obj 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 cb' :: C_WorkspaceNameChangedCallback
cb' = IO () -> C_WorkspaceNameChangedCallback
wrap_WorkspaceNameChangedCallback IO ()
cb
    FunPtr C_WorkspaceNameChangedCallback
cb'' <- C_WorkspaceNameChangedCallback
-> IO (FunPtr C_WorkspaceNameChangedCallback)
mk_WorkspaceNameChangedCallback C_WorkspaceNameChangedCallback
cb'
    a
-> Text
-> FunPtr C_WorkspaceNameChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"name-changed" FunPtr C_WorkspaceNameChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [nameChanged](#signal:nameChanged) 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' workspace #nameChanged callback
-- @
-- 
-- 
afterWorkspaceNameChanged :: (IsWorkspace a, MonadIO m) => a -> WorkspaceNameChangedCallback -> m SignalHandlerId
afterWorkspaceNameChanged :: a -> IO () -> m SignalHandlerId
afterWorkspaceNameChanged a
obj 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 cb' :: C_WorkspaceNameChangedCallback
cb' = IO () -> C_WorkspaceNameChangedCallback
wrap_WorkspaceNameChangedCallback IO ()
cb
    FunPtr C_WorkspaceNameChangedCallback
cb'' <- C_WorkspaceNameChangedCallback
-> IO (FunPtr C_WorkspaceNameChangedCallback)
mk_WorkspaceNameChangedCallback C_WorkspaceNameChangedCallback
cb'
    a
-> Text
-> FunPtr C_WorkspaceNameChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"name-changed" FunPtr C_WorkspaceNameChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WorkspaceNameChangedSignalInfo
instance SignalInfo WorkspaceNameChangedSignalInfo where
    type HaskellCallbackType WorkspaceNameChangedSignalInfo = WorkspaceNameChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WorkspaceNameChangedCallback cb
        cb'' <- mk_WorkspaceNameChangedCallback cb'
        connectSignalFunPtr obj "name-changed" cb'' connectMode detail

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Workspace = WorkspaceSignalList
type WorkspaceSignalList = ('[ '("nameChanged", WorkspaceNameChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Workspace::activate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "space"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Workspace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspace." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the X server timestamp of the user interaction event that caused\nthis call to occur."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "wnck_workspace_activate" wnck_workspace_activate :: 
    Ptr Workspace ->                        -- space : TInterface (Name {namespace = "Wnck", name = "Workspace"})
    Word32 ->                               -- timestamp : TBasicType TUInt32
    IO ()

-- | Asks the window manager to make /@space@/ the active workspace. The window
-- manager may decide to refuse the request (to not steal the focus if there is
-- a more recent user activity, for example).
-- 
-- This function existed before 2.10, but the /@timestamp@/ argument was missing
-- in earlier versions.
-- 
-- /Since: 2.10/
workspaceActivate ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> Word32
    -- ^ /@timestamp@/: the X server timestamp of the user interaction event that caused
    -- this call to occur.
    -> m ()
workspaceActivate :: a -> Word32 -> m ()
workspaceActivate a
space Word32
timestamp = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    Ptr Workspace -> Word32 -> IO ()
wnck_workspace_activate Ptr Workspace
space' Word32
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WorkspaceActivateMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceActivateMethodInfo a signature where
    overloadedMethod = workspaceActivate

#endif

-- method Workspace::change_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "space"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Workspace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspace." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new name for @space."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "wnck_workspace_change_name" wnck_workspace_change_name :: 
    Ptr Workspace ->                        -- space : TInterface (Name {namespace = "Wnck", name = "Workspace"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Changes the name of /@space@/.
-- 
-- /Since: 2.2/
workspaceChangeName ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> T.Text
    -- ^ /@name@/: new name for /@space@/.
    -> m ()
workspaceChangeName :: a -> Text -> m ()
workspaceChangeName a
space Text
name = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Workspace -> CString -> IO ()
wnck_workspace_change_name Ptr Workspace
space' CString
name'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

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

-- | Gets the height of /@space@/.
-- 
-- /Since: 2.4/
workspaceGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> m Int32
    -- ^ __Returns:__ the height of /@space@/.
workspaceGetHeight :: a -> m Int32
workspaceGetHeight a
space = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    Int32
result <- Ptr Workspace -> IO Int32
wnck_workspace_get_height Ptr Workspace
space'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data WorkspaceGetHeightMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceGetHeightMethodInfo a signature where
    overloadedMethod = workspaceGetHeight

#endif

-- method Workspace::get_layout_column
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "space"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Workspace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspace." , 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_workspace_get_layout_column" wnck_workspace_get_layout_column :: 
    Ptr Workspace ->                        -- space : TInterface (Name {namespace = "Wnck", name = "Workspace"})
    IO Int32

-- | Gets the column of /@space@/ in the t'GI.Wnck.Objects.Workspace.Workspace' layout. The first column
-- has an index of 0 and is always the left column, regardless of the starting
-- corner set for the layout and regardless of the default direction of the
-- environment (i.e., in both Left-To-Right and Right-To-Left environments).
-- 
-- /Since: 2.20/
workspaceGetLayoutColumn ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> m Int32
    -- ^ __Returns:__ the column of /@space@/ in the t'GI.Wnck.Objects.Workspace.Workspace' layout, or -1 on
    -- errors.
workspaceGetLayoutColumn :: a -> m Int32
workspaceGetLayoutColumn a
space = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    Int32
result <- Ptr Workspace -> IO Int32
wnck_workspace_get_layout_column Ptr Workspace
space'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data WorkspaceGetLayoutColumnMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceGetLayoutColumnMethodInfo a signature where
    overloadedMethod = workspaceGetLayoutColumn

#endif

-- method Workspace::get_layout_row
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "space"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Workspace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspace." , 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_workspace_get_layout_row" wnck_workspace_get_layout_row :: 
    Ptr Workspace ->                        -- space : TInterface (Name {namespace = "Wnck", name = "Workspace"})
    IO Int32

-- | Gets the row of /@space@/ in the t'GI.Wnck.Objects.Workspace.Workspace' layout. The first row has an
-- index of 0 and is always the top row, regardless of the starting corner set
-- for the layout.
-- 
-- /Since: 2.20/
workspaceGetLayoutRow ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> m Int32
    -- ^ __Returns:__ the row of /@space@/ in the t'GI.Wnck.Objects.Workspace.Workspace' layout, or -1 on
    -- errors.
workspaceGetLayoutRow :: a -> m Int32
workspaceGetLayoutRow a
space = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    Int32
result <- Ptr Workspace -> IO Int32
wnck_workspace_get_layout_row Ptr Workspace
space'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data WorkspaceGetLayoutRowMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceGetLayoutRowMethodInfo a signature where
    overloadedMethod = workspaceGetLayoutRow

#endif

-- method Workspace::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "space"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Workspace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspace." , 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_workspace_get_name" wnck_workspace_get_name :: 
    Ptr Workspace ->                        -- space : TInterface (Name {namespace = "Wnck", name = "Workspace"})
    IO CString

-- | Gets the human-readable name that should be used to refer to /@space@/. If
-- the user has not set a special name, a fallback like \"Workspace 3\" will be
-- used.
workspaceGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> m T.Text
    -- ^ __Returns:__ the name of /@space@/.
workspaceGetName :: a -> m Text
workspaceGetName a
space = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    CString
result <- Ptr Workspace -> IO CString
wnck_workspace_get_name Ptr Workspace
space'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"workspaceGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data WorkspaceGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceGetNameMethodInfo a signature where
    overloadedMethod = workspaceGetName

#endif

-- method Workspace::get_neighbor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "space"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Workspace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspace." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "MotionDirection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "direction in which to search the neighbor."
--                 , 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_workspace_get_neighbor" wnck_workspace_get_neighbor :: 
    Ptr Workspace ->                        -- space : TInterface (Name {namespace = "Wnck", name = "Workspace"})
    CInt ->                                 -- direction : TInterface (Name {namespace = "Wnck", name = "MotionDirection"})
    IO (Ptr Workspace)

-- | Gets the neighbor t'GI.Wnck.Objects.Workspace.Workspace' of /@space@/ in the /@direction@/ direction.
-- 
-- /Since: 2.20/
workspaceGetNeighbor ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> Wnck.Enums.MotionDirection
    -- ^ /@direction@/: direction in which to search the neighbor.
    -> m Workspace
    -- ^ __Returns:__ the neighbor t'GI.Wnck.Objects.Workspace.Workspace' of /@space@/ in the
    -- /@direction@/ direction, or 'P.Nothing' if no such neighbor t'GI.Wnck.Objects.Workspace.Workspace' exists.
    -- The returned t'GI.Wnck.Objects.Workspace.Workspace' is owned by libwnck and must not be referenced
    -- or unreferenced.
workspaceGetNeighbor :: a -> MotionDirection -> m Workspace
workspaceGetNeighbor a
space MotionDirection
direction = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    let direction' :: CInt
direction' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (MotionDirection -> Int) -> MotionDirection -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MotionDirection -> Int
forall a. Enum a => a -> Int
fromEnum) MotionDirection
direction
    Ptr Workspace
result <- Ptr Workspace -> CInt -> IO (Ptr Workspace)
wnck_workspace_get_neighbor Ptr Workspace
space' CInt
direction'
    Text -> Ptr Workspace -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"workspaceGetNeighbor" 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
Workspace) Ptr Workspace
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    Workspace -> IO Workspace
forall (m :: * -> *) a. Monad m => a -> m a
return Workspace
result'

#if defined(ENABLE_OVERLOADING)
data WorkspaceGetNeighborMethodInfo
instance (signature ~ (Wnck.Enums.MotionDirection -> m Workspace), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceGetNeighborMethodInfo a signature where
    overloadedMethod = workspaceGetNeighbor

#endif

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

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

#if defined(ENABLE_OVERLOADING)
data WorkspaceGetNumberMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceGetNumberMethodInfo a signature where
    overloadedMethod = workspaceGetNumber

#endif

-- method Workspace::get_screen
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "space"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Workspace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspace." , 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_workspace_get_screen" wnck_workspace_get_screen :: 
    Ptr Workspace ->                        -- space : TInterface (Name {namespace = "Wnck", name = "Workspace"})
    IO (Ptr Wnck.Screen.Screen)

-- | Gets the t'GI.Wnck.Objects.Screen.Screen' /@space@/ is on.
workspaceGetScreen ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> m Wnck.Screen.Screen
    -- ^ __Returns:__ the t'GI.Wnck.Objects.Screen.Screen' /@space@/ is on. The returned
    -- t'GI.Wnck.Objects.Screen.Screen' is owned by libwnck and must not be referenced or unreferenced.
workspaceGetScreen :: a -> m Screen
workspaceGetScreen a
space = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    Ptr Screen
result <- Ptr Workspace -> IO (Ptr Screen)
wnck_workspace_get_screen Ptr Workspace
space'
    Text -> Ptr Screen -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"workspaceGetScreen" 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
Wnck.Screen.Screen) Ptr Screen
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    Screen -> IO Screen
forall (m :: * -> *) a. Monad m => a -> m a
return Screen
result'

#if defined(ENABLE_OVERLOADING)
data WorkspaceGetScreenMethodInfo
instance (signature ~ (m Wnck.Screen.Screen), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceGetScreenMethodInfo a signature where
    overloadedMethod = workspaceGetScreen

#endif

-- method Workspace::get_viewport_x
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "space"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Workspace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspace." , 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_workspace_get_viewport_x" wnck_workspace_get_viewport_x :: 
    Ptr Workspace ->                        -- space : TInterface (Name {namespace = "Wnck", name = "Workspace"})
    IO Int32

-- | Gets the X coordinate of the viewport in /@space@/.
-- 
-- /Since: 2.4/
workspaceGetViewportX ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> m Int32
    -- ^ __Returns:__ the X coordinate of the viewport in /@space@/, or 0 if /@space@/ does not
    -- contain a viewport.
workspaceGetViewportX :: a -> m Int32
workspaceGetViewportX a
space = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    Int32
result <- Ptr Workspace -> IO Int32
wnck_workspace_get_viewport_x Ptr Workspace
space'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data WorkspaceGetViewportXMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceGetViewportXMethodInfo a signature where
    overloadedMethod = workspaceGetViewportX

#endif

-- method Workspace::get_viewport_y
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "space"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Workspace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspace." , 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_workspace_get_viewport_y" wnck_workspace_get_viewport_y :: 
    Ptr Workspace ->                        -- space : TInterface (Name {namespace = "Wnck", name = "Workspace"})
    IO Int32

-- | Gets the Y coordinate of the viewport in /@space@/.
-- 
-- /Since: 2.4/
workspaceGetViewportY ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> m Int32
    -- ^ __Returns:__ the Y coordinate of the viewport in /@space@/, or 0 if /@space@/ does not
    -- contain a viewport.
workspaceGetViewportY :: a -> m Int32
workspaceGetViewportY a
space = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    Int32
result <- Ptr Workspace -> IO Int32
wnck_workspace_get_viewport_y Ptr Workspace
space'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data WorkspaceGetViewportYMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceGetViewportYMethodInfo a signature where
    overloadedMethod = workspaceGetViewportY

#endif

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

-- | Gets the width of /@space@/.
-- 
-- /Since: 2.4/
workspaceGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> m Int32
    -- ^ __Returns:__ the width of /@space@/.
workspaceGetWidth :: a -> m Int32
workspaceGetWidth a
space = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    Int32
result <- Ptr Workspace -> IO Int32
wnck_workspace_get_width Ptr Workspace
space'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
space
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data WorkspaceGetWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceGetWidthMethodInfo a signature where
    overloadedMethod = workspaceGetWidth

#endif

-- method Workspace::is_virtual
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "space"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "Workspace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckWorkspace." , 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_workspace_is_virtual" wnck_workspace_is_virtual :: 
    Ptr Workspace ->                        -- space : TInterface (Name {namespace = "Wnck", name = "Workspace"})
    IO CInt

-- | Gets whether /@space@/ contains a viewport.
-- 
-- /Since: 2.4/
workspaceIsVirtual ::
    (B.CallStack.HasCallStack, MonadIO m, IsWorkspace a) =>
    a
    -- ^ /@space@/: a t'GI.Wnck.Objects.Workspace.Workspace'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@space@/ contains a viewport, 'P.False' otherwise.
workspaceIsVirtual :: a -> m Bool
workspaceIsVirtual a
space = 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 Workspace
space' <- a -> IO (Ptr Workspace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
space
    CInt
result <- Ptr Workspace -> IO CInt
wnck_workspace_is_virtual Ptr Workspace
space'
    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
space
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WorkspaceIsVirtualMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsWorkspace a) => O.MethodInfo WorkspaceIsVirtualMethodInfo a signature where
    overloadedMethod = workspaceIsVirtual

#endif