{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternGuards #-}

-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Hooks.EwmhDesktops
-- Description  : Make xmonad use the extended window manager hints (EWMH).
-- Copyright    : (c) 2007, 2008 Joachim Breitner <mail@joachim-breitner.de>
-- License      : BSD
--
-- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>
-- Stability    : unstable
-- Portability  : unportable
--
-- Makes xmonad use the
-- <https://specifications.freedesktop.org/wm-spec/latest/ EWMH>
-- hints to tell panel applications about its workspaces and the windows
-- therein. It also allows the user to interact with xmonad by clicking on
-- panels and window lists.
-----------------------------------------------------------------------------
module XMonad.Hooks.EwmhDesktops (
    -- * Usage
    -- $usage
    ewmh,
    ewmhFullscreen,

    -- * Customization
    -- $customization

    -- ** Sorting/filtering of workspaces
    -- $customSort
    addEwmhWorkspaceSort, setEwmhWorkspaceSort,

    -- ** Renaming of workspaces
    -- $customRename
    addEwmhWorkspaceRename, setEwmhWorkspaceRename,

    -- ** Window activation
    -- $customActivate
    setEwmhActivateHook,

    -- * Standalone hooks (deprecated)
    ewmhDesktopsStartup,
    ewmhDesktopsLogHook,
    ewmhDesktopsLogHookCustom,
    ewmhDesktopsEventHook,
    ewmhDesktopsEventHookCustom,
    fullscreenEventHook,
    fullscreenStartup,
    ) where

import Codec.Binary.UTF8.String (encode)
import Data.Bits
import qualified Data.Map.Strict as M

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W

import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.SetWMName
import XMonad.Util.WorkspaceCompare
import XMonad.Util.WindowProperties (getProp32)
import qualified XMonad.Util.ExtensibleConf as XC
import qualified XMonad.Util.ExtensibleState as XS

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Hooks.EwmhDesktops
-- >
-- > main = xmonad $ … . ewmhFullscreen . ewmh . … $ def{…}
--
-- or, if fullscreen handling is not desired, just
--
-- > main = xmonad $ … . ewmh . … $ def{…}
--
-- You may also be interested in 'XMonad.Hooks.ManageDocks.docks' and
-- 'XMonad.Hooks.UrgencyHook.withUrgencyHook', which provide support for other
-- parts of the
-- <https://specifications.freedesktop.org/wm-spec/latest/ EWMH specification>.

-- | Add EWMH support for workspaces (virtual desktops) to the given
-- 'XConfig'.  See above for an example.
ewmh :: XConfig a -> XConfig a
ewmh :: forall (a :: * -> *). XConfig a -> XConfig a
ewmh XConfig a
c = XConfig a
c { startupHook :: X ()
startupHook     = X ()
ewmhDesktopsStartup X () -> X () -> X ()
forall a. Semigroup a => a -> a -> a
<> XConfig a -> X ()
forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig a
c
           , handleEventHook :: Event -> X All
handleEventHook = Event -> X All
ewmhDesktopsEventHook (Event -> X All) -> (Event -> X All) -> Event -> X All
forall a. Semigroup a => a -> a -> a
<> XConfig a -> Event -> X All
forall (l :: * -> *). XConfig l -> Event -> X All
handleEventHook XConfig a
c
           , logHook :: X ()
logHook         = X ()
ewmhDesktopsLogHook X () -> X () -> X ()
forall a. Semigroup a => a -> a -> a
<> XConfig a -> X ()
forall (l :: * -> *). XConfig l -> X ()
logHook XConfig a
c }


-- $customization
-- It's possible to customize the behaviour of 'ewmh' in several ways:

-- | Customizable configuration for EwmhDesktops
data EwmhDesktopsConfig =
    EwmhDesktopsConfig
        { EwmhDesktopsConfig -> X WorkspaceSort
workspaceSort :: X WorkspaceSort
            -- ^ configurable workspace sorting/filtering
        , EwmhDesktopsConfig -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename :: X (String -> WindowSpace -> String)
            -- ^ configurable workspace rename (see 'XMonad.Hooks.StatusBar.PP.ppRename')
        , EwmhDesktopsConfig -> ManageHook
activateHook :: ManageHook
            -- ^ configurable handling of window activation requests
        }

instance Default EwmhDesktopsConfig where
    def :: EwmhDesktopsConfig
def = EwmhDesktopsConfig :: X WorkspaceSort
-> X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> ManageHook
-> EwmhDesktopsConfig
EwmhDesktopsConfig
        { workspaceSort :: X WorkspaceSort
workspaceSort = X WorkspaceSort
getSortByIndex
        , workspaceRename :: X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename = (WorkspaceId -> WindowSpace -> WorkspaceId)
-> X (WorkspaceId -> WindowSpace -> WorkspaceId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkspaceId -> WindowSpace -> WorkspaceId
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        , activateHook :: ManageHook
activateHook = ManageHook
doFocus
        }


-- $customSort
-- The list of workspaces exposed to EWMH pagers (like
-- <https://github.com/taffybar/taffybar taffybar> and
-- <https://github.com/polybar/polybar polybar>) and clients (such as
-- <http://tomas.styblo.name/wmctrl/ wmctrl> and
-- <https://github.com/jordansissel/xdotool/ xdotool>) may be sorted and/or
-- filtered via a user-defined function.
--
-- To show visible workspaces first, one may switch to a Xinerama-aware
-- sorting function:
--
-- > import XMonad.Util.WorkspaceCompare
-- >
-- > mySort = getSortByXineramaRule
-- > main = xmonad $ … . setEwmhWorkspaceSort mySort . ewmh . … $ def{…}
--
-- Another useful example is not exposing the hidden scratchpad workspace:
--
-- > import XMonad.Util.NamedScratchpad
-- > import XMonad.Util.WorkspaceCompare
-- >
-- > myFilter = filterOutWs [scratchpadWorkspaceTag]
-- > main = xmonad $ … . addEwmhWorkspaceSort (pure myFilter) . ewmh . … $ def{…}

-- | Add (compose after) an arbitrary user-specified function to sort/filter
-- the workspace list. The default/initial function is 'getSortByIndex'. This
-- can be used to e.g. filter out scratchpad workspaces. Workspaces /must not/
-- be renamed here.
addEwmhWorkspaceSort :: X WorkspaceSort -> XConfig l -> XConfig l
addEwmhWorkspaceSort :: forall (l :: * -> *). X WorkspaceSort -> XConfig l -> XConfig l
addEwmhWorkspaceSort X WorkspaceSort
f = (EwmhDesktopsConfig -> EwmhDesktopsConfig)
-> XConfig l -> XConfig l
forall a (l :: * -> *).
(Default a, Typeable a) =>
(a -> a) -> XConfig l -> XConfig l
XC.modifyDef ((EwmhDesktopsConfig -> EwmhDesktopsConfig)
 -> XConfig l -> XConfig l)
-> (EwmhDesktopsConfig -> EwmhDesktopsConfig)
-> XConfig l
-> XConfig l
forall a b. (a -> b) -> a -> b
$ \EwmhDesktopsConfig
c -> EwmhDesktopsConfig
c{ workspaceSort :: X WorkspaceSort
workspaceSort = (WorkspaceSort -> WorkspaceSort -> WorkspaceSort)
-> X WorkspaceSort -> X WorkspaceSort -> X WorkspaceSort
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 WorkspaceSort -> WorkspaceSort -> WorkspaceSort
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) X WorkspaceSort
f (EwmhDesktopsConfig -> X WorkspaceSort
workspaceSort EwmhDesktopsConfig
c) }

-- | Like 'addEwmhWorkspaceSort', but replace it instead of adding/composing.
setEwmhWorkspaceSort :: X WorkspaceSort -> XConfig l -> XConfig l
setEwmhWorkspaceSort :: forall (l :: * -> *). X WorkspaceSort -> XConfig l -> XConfig l
setEwmhWorkspaceSort X WorkspaceSort
f = (EwmhDesktopsConfig -> EwmhDesktopsConfig)
-> XConfig l -> XConfig l
forall a (l :: * -> *).
(Default a, Typeable a) =>
(a -> a) -> XConfig l -> XConfig l
XC.modifyDef ((EwmhDesktopsConfig -> EwmhDesktopsConfig)
 -> XConfig l -> XConfig l)
-> (EwmhDesktopsConfig -> EwmhDesktopsConfig)
-> XConfig l
-> XConfig l
forall a b. (a -> b) -> a -> b
$ \EwmhDesktopsConfig
c -> EwmhDesktopsConfig
c{ workspaceSort :: X WorkspaceSort
workspaceSort = X WorkspaceSort
f }


-- $customRename
-- The workspace names exposed to EWMH pagers and other clients (e.g.
-- <https://arbtt.nomeata.de/ arbtt>) may be altered using a similar
-- interface to 'XMonad.Hooks.StatusBar.PP.ppRename'. To configure workspace
-- renaming, use 'addEwmhWorkspaceRename'.
--
-- As an example, to expose workspaces uppercased:
--
-- > import Data.Char
-- >
-- > myRename :: String -> WindowSpace -> String
-- > myRename s _w = map toUpper s
-- >
-- > main = xmonad $ … . addEwmhWorkspaceRename (pure myRename) . ewmh . … $ def{…}
--
-- Some modules like "XMonad.Actions.WorkspaceNames" provide ready-made
-- integrations:
--
-- > import XMonad.Actions.WorkspaceNames
-- >
-- > main = xmonad $ … . workspaceNamesEwmh . ewmh . … $ def{…}
--
-- The above ensures workspace names are exposed through EWMH.

-- | Add (compose after) an arbitrary user-specified function to rename each
-- workspace. This works just like 'XMonad.Hooks.StatusBar.PP.ppRename': the
-- @WindowSpace -> …@ acts as a Reader monad. Useful with
-- "XMonad.Actions.WorkspaceNames", "XMonad.Layout.IndependentScreens",
-- "XMonad.Hooks.DynamicIcons".
addEwmhWorkspaceRename :: X (String -> WindowSpace -> String) -> XConfig l -> XConfig l
addEwmhWorkspaceRename :: forall (l :: * -> *).
X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> XConfig l -> XConfig l
addEwmhWorkspaceRename X (WorkspaceId -> WindowSpace -> WorkspaceId)
f = (EwmhDesktopsConfig -> EwmhDesktopsConfig)
-> XConfig l -> XConfig l
forall a (l :: * -> *).
(Default a, Typeable a) =>
(a -> a) -> XConfig l -> XConfig l
XC.modifyDef ((EwmhDesktopsConfig -> EwmhDesktopsConfig)
 -> XConfig l -> XConfig l)
-> (EwmhDesktopsConfig -> EwmhDesktopsConfig)
-> XConfig l
-> XConfig l
forall a b. (a -> b) -> a -> b
$ \EwmhDesktopsConfig
c -> EwmhDesktopsConfig
c{ workspaceRename :: X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename = ((WorkspaceId -> WindowSpace -> WorkspaceId)
 -> (WorkspaceId -> WindowSpace -> WorkspaceId)
 -> WorkspaceId
 -> WindowSpace
 -> WorkspaceId)
-> X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> X (WorkspaceId -> WindowSpace -> WorkspaceId)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (WorkspaceId -> WindowSpace -> WorkspaceId)
-> (WorkspaceId -> WindowSpace -> WorkspaceId)
-> WorkspaceId
-> WindowSpace
-> WorkspaceId
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
(<=<) X (WorkspaceId -> WindowSpace -> WorkspaceId)
f (EwmhDesktopsConfig -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename EwmhDesktopsConfig
c) }

-- | Like 'addEwmhWorkspaceRename', but replace it instead of adding/composing.
setEwmhWorkspaceRename :: X (String -> WindowSpace -> String) -> XConfig l -> XConfig l
setEwmhWorkspaceRename :: forall (l :: * -> *).
X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> XConfig l -> XConfig l
setEwmhWorkspaceRename X (WorkspaceId -> WindowSpace -> WorkspaceId)
f = (EwmhDesktopsConfig -> EwmhDesktopsConfig)
-> XConfig l -> XConfig l
forall a (l :: * -> *).
(Default a, Typeable a) =>
(a -> a) -> XConfig l -> XConfig l
XC.modifyDef ((EwmhDesktopsConfig -> EwmhDesktopsConfig)
 -> XConfig l -> XConfig l)
-> (EwmhDesktopsConfig -> EwmhDesktopsConfig)
-> XConfig l
-> XConfig l
forall a b. (a -> b) -> a -> b
$ \EwmhDesktopsConfig
c -> EwmhDesktopsConfig
c{ workspaceRename :: X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename = X (WorkspaceId -> WindowSpace -> WorkspaceId)
f }


-- $customActivate
-- When a client sends a @_NET_ACTIVE_WINDOW@ request to activate a window, by
-- default that window is activated by invoking the 'doFocus' 'ManageHook'.
-- <https://specifications.freedesktop.org/wm-spec/1.5/ar01s03.html#idm45623294083744 The EWMH specification suggests>
-- that a window manager may instead just mark the window as urgent, and this
-- can be achieved using the following:
--
-- > import XMonad.Hooks.UrgencyHook
-- >
-- > main = xmonad $ … . setEwmhActivateHook doAskUrgent . ewmh . … $ def{…}
--
-- One may also wish to ignore activation requests from certain applications
-- entirely:
--
-- > import XMonad.Hooks.ManageHelpers
-- >
-- > myActivateHook :: ManageHook
-- > myActivateHook =
-- >   className /=? "Google-chrome" <&&> className /=? "google-chrome" --> doFocus
-- >
-- > main = xmonad $ … . setEwmhActivateHook myActivateHook . ewmh . … $ def{…}
--
-- Arbitrarily complex hooks can be used. This last example marks Chrome
-- windows as urgent and focuses everything else:
--
-- > myActivateHook :: ManageHook
-- > myActivateHook = composeOne
-- >   [ className =? "Google-chrome" <||> className =? "google-chrome" -?> doAskUrgent
-- >   , pure True -?> doFocus ]
--
-- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus"
-- for functions that can be useful here.

-- | Set (replace) the hook which is invoked when a client sends a
-- @_NET_ACTIVE_WINDOW@ request to activate a window. The default is 'doFocus'
-- which focuses the window immediately, switching workspace if necessary.
-- 'XMonad.Hooks.UrgencyHook.doAskUrgent' is a less intrusive alternative.
--
-- More complex hooks can be constructed using combinators from
-- "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus".
setEwmhActivateHook :: ManageHook -> XConfig l -> XConfig l
setEwmhActivateHook :: forall (l :: * -> *). ManageHook -> XConfig l -> XConfig l
setEwmhActivateHook ManageHook
h = (EwmhDesktopsConfig -> EwmhDesktopsConfig)
-> XConfig l -> XConfig l
forall a (l :: * -> *).
(Default a, Typeable a) =>
(a -> a) -> XConfig l -> XConfig l
XC.modifyDef ((EwmhDesktopsConfig -> EwmhDesktopsConfig)
 -> XConfig l -> XConfig l)
-> (EwmhDesktopsConfig -> EwmhDesktopsConfig)
-> XConfig l
-> XConfig l
forall a b. (a -> b) -> a -> b
$ \EwmhDesktopsConfig
c -> EwmhDesktopsConfig
c{ activateHook :: ManageHook
activateHook = ManageHook
h }


-- | Initializes EwmhDesktops and advertises EWMH support to the X server.
{-# DEPRECATED ewmhDesktopsStartup "Use ewmh instead." #-}
ewmhDesktopsStartup :: X ()
ewmhDesktopsStartup :: X ()
ewmhDesktopsStartup = X ()
setSupported

-- | Notifies pagers and window lists, such as those in the gnome-panel of the
-- current state of workspaces and windows.
{-# DEPRECATED ewmhDesktopsLogHook "Use ewmh instead." #-}
ewmhDesktopsLogHook :: X ()
ewmhDesktopsLogHook :: X ()
ewmhDesktopsLogHook = (EwmhDesktopsConfig -> X ()) -> X ()
forall (m :: * -> *) a b.
(MonadReader XConf m, Typeable a, Default a) =>
(a -> m b) -> m b
XC.withDef EwmhDesktopsConfig -> X ()
ewmhDesktopsLogHook'

-- | Generalized version of ewmhDesktopsLogHook that allows an arbitrary
-- user-specified function to sort/filter the workspace list (post-sorting).
{-# DEPRECATED ewmhDesktopsLogHookCustom "Use ewmh and addEwmhWorkspaceSort instead." #-}
ewmhDesktopsLogHookCustom :: WorkspaceSort -> X ()
ewmhDesktopsLogHookCustom :: WorkspaceSort -> X ()
ewmhDesktopsLogHookCustom WorkspaceSort
f =
    EwmhDesktopsConfig -> X ()
ewmhDesktopsLogHook' EwmhDesktopsConfig
forall a. Default a => a
def{ workspaceSort :: X WorkspaceSort
workspaceSort = (WorkspaceSort
f WorkspaceSort -> WorkspaceSort -> WorkspaceSort
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (WorkspaceSort -> WorkspaceSort)
-> X WorkspaceSort -> X WorkspaceSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EwmhDesktopsConfig -> X WorkspaceSort
workspaceSort EwmhDesktopsConfig
forall a. Default a => a
def }

-- | Intercepts messages from pagers and similar applications and reacts on them.
--
-- Currently supports:
--
--  * _NET_CURRENT_DESKTOP (switching desktops)
--
--  * _NET_WM_DESKTOP (move windows to other desktops)
--
--  * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)
--
--  * _NET_CLOSE_WINDOW (close window)
{-# DEPRECATED ewmhDesktopsEventHook "Use ewmh instead." #-}
ewmhDesktopsEventHook :: Event -> X All
ewmhDesktopsEventHook :: Event -> X All
ewmhDesktopsEventHook = (EwmhDesktopsConfig -> X All) -> X All
forall (m :: * -> *) a b.
(MonadReader XConf m, Typeable a, Default a) =>
(a -> m b) -> m b
XC.withDef ((EwmhDesktopsConfig -> X All) -> X All)
-> (Event -> EwmhDesktopsConfig -> X All) -> Event -> X All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> EwmhDesktopsConfig -> X All
ewmhDesktopsEventHook'

-- | Generalized version of ewmhDesktopsEventHook that allows an arbitrary
-- user-specified function to sort/filter the workspace list (post-sorting).
{-# DEPRECATED ewmhDesktopsEventHookCustom "Use ewmh and addEwmhWorkspaceSort instead." #-}
ewmhDesktopsEventHookCustom :: WorkspaceSort -> Event -> X All
ewmhDesktopsEventHookCustom :: WorkspaceSort -> Event -> X All
ewmhDesktopsEventHookCustom WorkspaceSort
f Event
e =
    Event -> EwmhDesktopsConfig -> X All
ewmhDesktopsEventHook' Event
e EwmhDesktopsConfig
forall a. Default a => a
def{ workspaceSort :: X WorkspaceSort
workspaceSort = (WorkspaceSort
f WorkspaceSort -> WorkspaceSort -> WorkspaceSort
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (WorkspaceSort -> WorkspaceSort)
-> X WorkspaceSort -> X WorkspaceSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EwmhDesktopsConfig -> X WorkspaceSort
workspaceSort EwmhDesktopsConfig
forall a. Default a => a
def }

-- | Cached @_NET_DESKTOP_NAMES@, @_NET_NUMBER_OF_DESKTOPS@
newtype DesktopNames = DesktopNames [String] deriving DesktopNames -> DesktopNames -> Bool
(DesktopNames -> DesktopNames -> Bool)
-> (DesktopNames -> DesktopNames -> Bool) -> Eq DesktopNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DesktopNames -> DesktopNames -> Bool
$c/= :: DesktopNames -> DesktopNames -> Bool
== :: DesktopNames -> DesktopNames -> Bool
$c== :: DesktopNames -> DesktopNames -> Bool
Eq
instance ExtensionClass DesktopNames where initialValue :: DesktopNames
initialValue = [WorkspaceId] -> DesktopNames
DesktopNames []

-- | Cached @_NET_CLIENT_LIST@
newtype ClientList = ClientList [Window] deriving ClientList -> ClientList -> Bool
(ClientList -> ClientList -> Bool)
-> (ClientList -> ClientList -> Bool) -> Eq ClientList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientList -> ClientList -> Bool
$c/= :: ClientList -> ClientList -> Bool
== :: ClientList -> ClientList -> Bool
$c== :: ClientList -> ClientList -> Bool
Eq
instance ExtensionClass ClientList where initialValue :: ClientList
initialValue = [Atom] -> ClientList
ClientList [Atom
none]

-- | Cached @_NET_CLIENT_LIST_STACKING@
newtype ClientListStacking = ClientListStacking [Window] deriving ClientListStacking -> ClientListStacking -> Bool
(ClientListStacking -> ClientListStacking -> Bool)
-> (ClientListStacking -> ClientListStacking -> Bool)
-> Eq ClientListStacking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientListStacking -> ClientListStacking -> Bool
$c/= :: ClientListStacking -> ClientListStacking -> Bool
== :: ClientListStacking -> ClientListStacking -> Bool
$c== :: ClientListStacking -> ClientListStacking -> Bool
Eq
instance ExtensionClass ClientListStacking where initialValue :: ClientListStacking
initialValue = [Atom] -> ClientListStacking
ClientListStacking [Atom
none]

-- | Cached @_NET_CURRENT_DESKTOP@
newtype CurrentDesktop = CurrentDesktop Int deriving CurrentDesktop -> CurrentDesktop -> Bool
(CurrentDesktop -> CurrentDesktop -> Bool)
-> (CurrentDesktop -> CurrentDesktop -> Bool) -> Eq CurrentDesktop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrentDesktop -> CurrentDesktop -> Bool
$c/= :: CurrentDesktop -> CurrentDesktop -> Bool
== :: CurrentDesktop -> CurrentDesktop -> Bool
$c== :: CurrentDesktop -> CurrentDesktop -> Bool
Eq
instance ExtensionClass CurrentDesktop where initialValue :: CurrentDesktop
initialValue = Int -> CurrentDesktop
CurrentDesktop (Int -> Int
forall a. Bits a => a -> a
complement Int
0)

-- | Cached @_NET_WM_DESKTOP@
newtype WindowDesktops = WindowDesktops (M.Map Window Int) deriving WindowDesktops -> WindowDesktops -> Bool
(WindowDesktops -> WindowDesktops -> Bool)
-> (WindowDesktops -> WindowDesktops -> Bool) -> Eq WindowDesktops
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowDesktops -> WindowDesktops -> Bool
$c/= :: WindowDesktops -> WindowDesktops -> Bool
== :: WindowDesktops -> WindowDesktops -> Bool
$c== :: WindowDesktops -> WindowDesktops -> Bool
Eq
instance ExtensionClass WindowDesktops where initialValue :: WindowDesktops
initialValue = Map Atom Int -> WindowDesktops
WindowDesktops (Atom -> Int -> Map Atom Int
forall k a. k -> a -> Map k a
M.singleton Atom
none (Int -> Int
forall a. Bits a => a -> a
complement Int
0))

-- | Cached @_NET_ACTIVE_WINDOW@
newtype ActiveWindow = ActiveWindow Window deriving ActiveWindow -> ActiveWindow -> Bool
(ActiveWindow -> ActiveWindow -> Bool)
-> (ActiveWindow -> ActiveWindow -> Bool) -> Eq ActiveWindow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveWindow -> ActiveWindow -> Bool
$c/= :: ActiveWindow -> ActiveWindow -> Bool
== :: ActiveWindow -> ActiveWindow -> Bool
$c== :: ActiveWindow -> ActiveWindow -> Bool
Eq
instance ExtensionClass ActiveWindow where initialValue :: ActiveWindow
initialValue = Atom -> ActiveWindow
ActiveWindow (Atom -> Atom
forall a. Bits a => a -> a
complement Atom
none)

-- | Cached @_NET_DESKTOP_VIEWPORT@
newtype MonitorTags = MonitorTags [WorkspaceId] deriving (Int -> MonitorTags -> ShowS
[MonitorTags] -> ShowS
MonitorTags -> WorkspaceId
(Int -> MonitorTags -> ShowS)
-> (MonitorTags -> WorkspaceId)
-> ([MonitorTags] -> ShowS)
-> Show MonitorTags
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [MonitorTags] -> ShowS
$cshowList :: [MonitorTags] -> ShowS
show :: MonitorTags -> WorkspaceId
$cshow :: MonitorTags -> WorkspaceId
showsPrec :: Int -> MonitorTags -> ShowS
$cshowsPrec :: Int -> MonitorTags -> ShowS
Show,MonitorTags -> MonitorTags -> Bool
(MonitorTags -> MonitorTags -> Bool)
-> (MonitorTags -> MonitorTags -> Bool) -> Eq MonitorTags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorTags -> MonitorTags -> Bool
$c/= :: MonitorTags -> MonitorTags -> Bool
== :: MonitorTags -> MonitorTags -> Bool
$c== :: MonitorTags -> MonitorTags -> Bool
Eq)
instance ExtensionClass MonitorTags where initialValue :: MonitorTags
initialValue = [WorkspaceId] -> MonitorTags
MonitorTags []

-- | Compare the given value against the value in the extensible state. Run the
-- action if it has changed.
whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged :: forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged = X Bool -> X () -> X ()
whenX (X Bool -> X () -> X ()) -> (a -> X Bool) -> a -> X () -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> X Bool
forall a (m :: * -> *).
(ExtensionClass a, Eq a, XLike m) =>
(a -> a) -> m Bool
XS.modified ((a -> a) -> X Bool) -> (a -> a -> a) -> a -> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a b. a -> b -> a
const

ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X ()
ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X ()
ewmhDesktopsLogHook' EwmhDesktopsConfig{X WorkspaceSort
workspaceSort :: X WorkspaceSort
workspaceSort :: EwmhDesktopsConfig -> X WorkspaceSort
workspaceSort, X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename :: X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename :: EwmhDesktopsConfig -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename} = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
    WorkspaceSort
sort' <- X WorkspaceSort
workspaceSort
    let ws :: [WindowSpace]
ws = WorkspaceSort
sort' WorkspaceSort -> WorkspaceSort
forall a b. (a -> b) -> a -> b
$ WindowSet -> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
s

    -- Set number of workspaces and names thereof
    WorkspaceId -> WindowSpace -> WorkspaceId
rename <- X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename
    let desktopNames :: [WorkspaceId]
desktopNames = [ WorkspaceId -> WindowSpace -> WorkspaceId
rename (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag WindowSpace
w) WindowSpace
w | WindowSpace
w <- [WindowSpace]
ws ]
    DesktopNames -> X () -> X ()
forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged ([WorkspaceId] -> DesktopNames
DesktopNames [WorkspaceId]
desktopNames) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
        Int -> X ()
forall a. Integral a => a -> X ()
setNumberOfDesktops ([WorkspaceId] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WorkspaceId]
desktopNames)
        [WorkspaceId] -> X ()
setDesktopNames [WorkspaceId]
desktopNames

    -- Set client list which should be sorted by window age. We just
    -- guess that StackSet contains windows list in this order which
    -- isn't true but at least gives consistency with windows cycling
    let clientList :: [Atom]
clientList = [Atom] -> [Atom]
forall a. Eq a => [a] -> [a]
nub ([Atom] -> [Atom])
-> ([WindowSpace] -> [Atom]) -> [WindowSpace] -> [Atom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSpace -> [Atom]) -> [WindowSpace] -> [Atom]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe (Stack Atom) -> [Atom]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack Atom) -> [Atom])
-> (WindowSpace -> Maybe (Stack Atom)) -> WindowSpace -> [Atom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack Atom)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) ([WindowSpace] -> [Atom]) -> [WindowSpace] -> [Atom]
forall a b. (a -> b) -> a -> b
$ [WindowSpace]
ws
    ClientList -> X () -> X ()
forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged ([Atom] -> ClientList
ClientList [Atom]
clientList) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ [Atom] -> X ()
setClientList [Atom]
clientList

    -- Set stacking client list which should have bottom-to-top
    -- stacking order, i.e. focused window should be last
    let clientListStacking :: [Atom]
clientListStacking = [Atom] -> [Atom]
forall a. Eq a => [a] -> [a]
nub ([Atom] -> [Atom])
-> ([WindowSpace] -> [Atom]) -> [WindowSpace] -> [Atom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSpace -> [Atom]) -> [WindowSpace] -> [Atom]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Atom] -> (Stack Atom -> [Atom]) -> Maybe (Stack Atom) -> [Atom]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(W.Stack Atom
x [Atom]
l [Atom]
r) -> [Atom] -> [Atom]
forall a. [a] -> [a]
reverse [Atom]
l [Atom] -> [Atom] -> [Atom]
forall a. [a] -> [a] -> [a]
++ [Atom]
r [Atom] -> [Atom] -> [Atom]
forall a. [a] -> [a] -> [a]
++ [Atom
x]) (Maybe (Stack Atom) -> [Atom])
-> (WindowSpace -> Maybe (Stack Atom)) -> WindowSpace -> [Atom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack Atom)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) ([WindowSpace] -> [Atom]) -> [WindowSpace] -> [Atom]
forall a b. (a -> b) -> a -> b
$ [WindowSpace]
ws
    ClientListStacking -> X () -> X ()
forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged ([Atom] -> ClientListStacking
ClientListStacking [Atom]
clientListStacking) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ [Atom] -> X ()
setClientListStacking [Atom]
clientListStacking

    -- Set current desktop number
    let current :: Maybe Int
current = WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
s WorkspaceId -> [WorkspaceId] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` (WindowSpace -> WorkspaceId) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag [WindowSpace]
ws
    CurrentDesktop -> X () -> X ()
forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged (Int -> CurrentDesktop
CurrentDesktop (Int -> CurrentDesktop) -> Int -> CurrentDesktop
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
current) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
        (Int -> X ()) -> Maybe Int -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> X ()
forall a. Integral a => a -> X ()
setCurrentDesktop Maybe Int
current

    -- Set window-desktop mapping
    let windowDesktops :: Map Atom Int
windowDesktops =
          let f :: a -> Workspace i l k -> Map k a
f a
wsId Workspace i l k
workspace = [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (k
winId, a
wsId) | k
winId <- Maybe (Stack k) -> [k]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack k) -> [k]) -> Maybe (Stack k) -> [k]
forall a b. (a -> b) -> a -> b
$ Workspace i l k -> Maybe (Stack k)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace i l k
workspace ]
          in [Map Atom Int] -> Map Atom Int
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Map Atom Int] -> Map Atom Int) -> [Map Atom Int] -> Map Atom Int
forall a b. (a -> b) -> a -> b
$ (Int -> WindowSpace -> Map Atom Int)
-> [Int] -> [WindowSpace] -> [Map Atom Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> WindowSpace -> Map Atom Int
forall {k} {a} {i} {l}. Ord k => a -> Workspace i l k -> Map k a
f [Int
0..] [WindowSpace]
ws
    WindowDesktops -> X () -> X ()
forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged (Map Atom Int -> WindowDesktops
WindowDesktops Map Atom Int
windowDesktops) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
        ((Atom, Int) -> X ()) -> [(Atom, Int)] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Atom -> Int -> X ()) -> (Atom, Int) -> X ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Atom -> Int -> X ()
forall a. Integral a => Atom -> a -> X ()
setWindowDesktop) (Map Atom Int -> [(Atom, Int)]
forall k a. Map k a -> [(k, a)]
M.toList Map Atom Int
windowDesktops)

    -- Set active window
    let activeWindow' :: Atom
activeWindow' = Atom -> Maybe Atom -> Atom
forall a. a -> Maybe a -> a
fromMaybe Atom
none (WindowSet -> Maybe Atom
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
s)
    ActiveWindow -> X () -> X ()
forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged (Atom -> ActiveWindow
ActiveWindow Atom
activeWindow') (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ Atom -> X ()
setActiveWindow Atom
activeWindow'

    -- Set desktop Viewport
    let visibleScreens :: [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
visibleScreens = WindowSet
-> Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
s Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
-> [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
s
        currentTags :: [WorkspaceId]
currentTags    = (Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
 -> WorkspaceId)
-> [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
-> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (WindowSpace -> WorkspaceId)
-> (Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
    -> WindowSpace)
-> Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
visibleScreens
    MonitorTags -> X () -> X ()
forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged ([WorkspaceId] -> MonitorTags
MonitorTags [WorkspaceId]
currentTags) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ WindowSet -> [WorkspaceId] -> X ()
mkViewPorts WindowSet
s ((WindowSpace -> WorkspaceId) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag [WindowSpace]
ws)

-- | Create the viewports from the current 'WindowSet' and a list of
-- already sorted workspace IDs.
mkViewPorts :: WindowSet -> [WorkspaceId] -> X ()
mkViewPorts :: WindowSet -> [WorkspaceId] -> X ()
mkViewPorts WindowSet
winset = [Position] -> X ()
setDesktopViewport ([Position] -> X ())
-> ([WorkspaceId] -> [Position]) -> [WorkspaceId] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Position]] -> [Position]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Position]] -> [Position])
-> ([WorkspaceId] -> [[Position]]) -> [WorkspaceId] -> [Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceId -> Maybe [Position]) -> [WorkspaceId] -> [[Position]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Map WorkspaceId [Position]
viewPorts Map WorkspaceId [Position] -> WorkspaceId -> Maybe [Position]
forall k a. Ord k => Map k a -> k -> Maybe a
M.!?)
  where
    foc :: Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
foc = WindowSet
-> Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
winset
    -- Hidden workspaces are mapped to the current screen's viewport.
    viewPorts :: M.Map WorkspaceId [Position]
    viewPorts :: Map WorkspaceId [Position]
viewPorts = [(WorkspaceId, [Position])] -> Map WorkspaceId [Position]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(WorkspaceId, [Position])] -> Map WorkspaceId [Position])
-> [(WorkspaceId, [Position])] -> Map WorkspaceId [Position]
forall a b. (a -> b) -> a -> b
$ (Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
 -> (WorkspaceId, [Position]))
-> [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
-> [(WorkspaceId, [Position])]
forall a b. (a -> b) -> [a] -> [b]
map Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> (WorkspaceId, [Position])
mkVisibleViewPort (Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
foc Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
-> [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
winset)
                          [(WorkspaceId, [Position])]
-> [(WorkspaceId, [Position])] -> [(WorkspaceId, [Position])]
forall a. [a] -> [a] -> [a]
++ (WindowSpace -> (WorkspaceId, [Position]))
-> [WindowSpace] -> [(WorkspaceId, [Position])]
forall a b. (a -> b) -> [a] -> [b]
map (Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> WindowSpace -> (WorkspaceId, [Position])
mkViewPort Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
foc)  (WindowSet -> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.hidden WindowSet
winset)

    mkViewPort :: WindowScreen -> WindowSpace -> (WorkspaceId, [Position])
    mkViewPort :: Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> WindowSpace -> (WorkspaceId, [Position])
mkViewPort Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
scr WindowSpace
w = (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag WindowSpace
w, Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> [Position]
mkPos Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
scr)

    mkVisibleViewPort :: WindowScreen -> (WorkspaceId, [Position])
    mkVisibleViewPort :: Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> (WorkspaceId, [Position])
mkVisibleViewPort Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
x = Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> WindowSpace -> (WorkspaceId, [Position])
mkViewPort Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
x (Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
x)

    mkPos :: WindowScreen -> [Position]
    mkPos :: Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> [Position]
mkPos Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
scr = [Rectangle -> Position
rect_x (Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> Rectangle
forall {i} {l} {a} {sid}.
Screen i l a sid ScreenDetail -> Rectangle
rect Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
scr), Rectangle -> Position
rect_y (Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> Rectangle
forall {i} {l} {a} {sid}.
Screen i l a sid ScreenDetail -> Rectangle
rect Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
scr)]
      where rect :: Screen i l a sid ScreenDetail -> Rectangle
rect = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle)
-> (Screen i l a sid ScreenDetail -> ScreenDetail)
-> Screen i l a sid ScreenDetail
-> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a sid ScreenDetail -> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail

ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All
ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All
ewmhDesktopsEventHook'
        ClientMessageEvent{ev_window :: Event -> Atom
ev_window = Atom
w, ev_message_type :: Event -> Atom
ev_message_type = Atom
mt, ev_data :: Event -> [CInt]
ev_data = [CInt]
d}
        EwmhDesktopsConfig{X WorkspaceSort
workspaceSort :: X WorkspaceSort
workspaceSort :: EwmhDesktopsConfig -> X WorkspaceSort
workspaceSort, ManageHook
activateHook :: ManageHook
activateHook :: EwmhDesktopsConfig -> ManageHook
activateHook} =
    (WindowSet -> X All) -> X All
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X All) -> X All) -> (WindowSet -> X All) -> X All
forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
        WorkspaceSort
sort' <- X WorkspaceSort
workspaceSort
        let ws :: [WindowSpace]
ws = WorkspaceSort
sort' WorkspaceSort -> WorkspaceSort
forall a b. (a -> b) -> a -> b
$ WindowSet -> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
s

        Atom
a_cd <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_CURRENT_DESKTOP"
        Atom
a_d <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_DESKTOP"
        Atom
a_aw <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_ACTIVE_WINDOW"
        Atom
a_cw <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_CLOSE_WINDOW"

        if  | Atom
mt Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
a_cd, CInt
n : [CInt]
_ <- [CInt]
d, Just WindowSpace
ww <- [WindowSpace]
ws [WindowSpace] -> Int -> Maybe WindowSpace
forall a. [a] -> Int -> Maybe a
!? CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
n ->
                if WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
s WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag WindowSpace
ww then X ()
forall a. Monoid a => a
mempty else (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag WindowSpace
ww)
            | Atom
mt Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
a_cd ->
                WorkspaceId -> X ()
forall (m :: * -> *). MonadIO m => WorkspaceId -> m ()
trace (WorkspaceId -> X ()) -> WorkspaceId -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId
"Bad _NET_CURRENT_DESKTOP with data=" WorkspaceId -> ShowS
forall a. [a] -> [a] -> [a]
++ [CInt] -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show [CInt]
d
            | Atom
mt Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
a_d, CInt
n : [CInt]
_ <- [CInt]
d, Just WindowSpace
ww <- [WindowSpace]
ws [WindowSpace] -> Int -> Maybe WindowSpace
forall a. [a] -> Int -> Maybe a
!? CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
n ->
                if Atom -> WindowSet -> Maybe WorkspaceId
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Atom
w WindowSet
s Maybe WorkspaceId -> Maybe WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceId -> Maybe WorkspaceId
forall a. a -> Maybe a
Just (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag WindowSpace
ww) then X ()
forall a. Monoid a => a
mempty else (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> Atom -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag WindowSpace
ww) Atom
w
            | Atom
mt Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
a_d ->
                WorkspaceId -> X ()
forall (m :: * -> *). MonadIO m => WorkspaceId -> m ()
trace (WorkspaceId -> X ()) -> WorkspaceId -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId
"Bad _NET_WM_DESKTOP with data=" WorkspaceId -> ShowS
forall a. [a] -> [a] -> [a]
++ [CInt] -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show [CInt]
d
            | Atom
mt Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
a_aw, CInt
2 : [CInt]
_ <- [CInt]
d ->
                -- when the request comes from a pager, honor it unconditionally
                -- https://specifications.freedesktop.org/wm-spec/wm-spec-1.3.html#sourceindication
                if WindowSet -> Maybe Atom
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
s Maybe Atom -> Maybe Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom -> Maybe Atom
forall a. a -> Maybe a
Just Atom
w then X ()
forall a. Monoid a => a
mempty else (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ Atom -> WindowSet -> WindowSet
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow Atom
w
            | Atom
mt Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
a_aw -> do
                if WindowSet -> Maybe Atom
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
s Maybe Atom -> Maybe Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom -> Maybe Atom
forall a. a -> Maybe a
Just Atom
w then X ()
forall a. Monoid a => a
mempty else (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Endo WindowSet -> WindowSet -> WindowSet)
-> Endo WindowSet
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo WindowSet -> WindowSet -> WindowSet
forall a. Endo a -> a -> a
appEndo (Endo WindowSet -> X ()) -> X (Endo WindowSet) -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ManageHook -> Atom -> X (Endo WindowSet)
forall a. Query a -> Atom -> X a
runQuery ManageHook
activateHook Atom
w
            | Atom
mt Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
a_cw ->
                Atom -> X ()
killWindow Atom
w
            | Bool
otherwise ->
                -- The Message is unknown to us, but that is ok, not all are meant
                -- to be handled by the window manager
                X ()
forall a. Monoid a => a
mempty

        X All
forall a. Monoid a => a
mempty
ewmhDesktopsEventHook' Event
_ EwmhDesktopsConfig
_ = X All
forall a. Monoid a => a
mempty

-- | Add EWMH fullscreen functionality to the given config.
ewmhFullscreen :: XConfig a -> XConfig a
ewmhFullscreen :: forall (a :: * -> *). XConfig a -> XConfig a
ewmhFullscreen XConfig a
c = XConfig a
c { startupHook :: X ()
startupHook     = XConfig a -> X ()
forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig a
c X () -> X () -> X ()
forall a. Semigroup a => a -> a -> a
<> X ()
fullscreenStartup
                     , handleEventHook :: Event -> X All
handleEventHook = XConfig a -> Event -> X All
forall (l :: * -> *). XConfig l -> Event -> X All
handleEventHook XConfig a
c (Event -> X All) -> (Event -> X All) -> Event -> X All
forall a. Semigroup a => a -> a -> a
<> Event -> X All
fullscreenEventHook }

-- | Advertises EWMH fullscreen support to the X server.
{-# DEPRECATED fullscreenStartup "Use ewmhFullscreen instead." #-}
fullscreenStartup :: X ()
fullscreenStartup :: X ()
fullscreenStartup = X ()
setFullscreenSupported

-- | An event hook to handle applications that wish to fullscreen using the
-- @_NET_WM_STATE@ protocol. This includes users of the @gtk_window_fullscreen()@
-- function, such as Totem, Evince and OpenOffice.org.
--
-- Note this is not included in 'ewmh'.
{-# DEPRECATED fullscreenEventHook "Use ewmhFullscreen instead." #-}
fullscreenEventHook :: Event -> X All
fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent EventType
_ CULong
_ Bool
_ Display
dpy Atom
win Atom
typ (CInt
action:[CInt]
dats)) = do
  Bool
managed <- Atom -> X Bool
isClient Atom
win
  Atom
wmstate <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_STATE"
  Atom
fullsc <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_STATE_FULLSCREEN"
  [CLong]
wstate <- [CLong] -> Maybe [CLong] -> [CLong]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [CLong] -> [CLong]) -> X (Maybe [CLong]) -> X [CLong]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Atom -> Atom -> X (Maybe [CLong])
getProp32 Atom
wmstate Atom
win

  let isFull :: Bool
isFull = Atom -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Atom
fullsc CLong -> [CLong] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLong]
wstate

      -- Constants for the _NET_WM_STATE protocol:
      remove :: CInt
remove = CInt
0
      add :: CInt
add = CInt
1
      toggle :: CInt
toggle = CInt
2
      chWstate :: ([CLong] -> [CLong]) -> m ()
chWstate [CLong] -> [CLong]
f = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
win Atom
wmstate Atom
aTOM CInt
propModeReplace ([CLong] -> [CLong]
f [CLong]
wstate)

  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
managed Bool -> Bool -> Bool
&& Atom
typ Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
wmstate Bool -> Bool -> Bool
&& Atom -> CInt
forall a b. (Integral a, Num b) => a -> b
fi Atom
fullsc CInt -> [CInt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CInt]
dats) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
add Bool -> Bool -> Bool
|| (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
toggle Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isFull)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
      ([CLong] -> [CLong]) -> X ()
forall {m :: * -> *}. MonadIO m => ([CLong] -> [CLong]) -> m ()
chWstate (Atom -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Atom
fullscCLong -> [CLong] -> [CLong]
forall a. a -> [a] -> [a]
:)
      (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ Atom -> RationalRect -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Atom
win (RationalRect -> WindowSet -> WindowSet)
-> RationalRect -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
1
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
remove Bool -> Bool -> Bool
|| (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
toggle Bool -> Bool -> Bool
&& Bool
isFull)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
      ([CLong] -> [CLong]) -> X ()
forall {m :: * -> *}. MonadIO m => ([CLong] -> [CLong]) -> m ()
chWstate (([CLong] -> [CLong]) -> X ()) -> ([CLong] -> [CLong]) -> X ()
forall a b. (a -> b) -> a -> b
$ CLong -> [CLong] -> [CLong]
forall a. Eq a => a -> [a] -> [a]
delete (Atom -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Atom
fullsc)
      (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ Atom -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.sink Atom
win

  All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True

fullscreenEventHook Event
_ = All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True

setNumberOfDesktops :: (Integral a) => a -> X ()
setNumberOfDesktops :: forall a. Integral a => a -> X ()
setNumberOfDesktops a
n = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Atom
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_NUMBER_OF_DESKTOPS"
    Atom
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
r Atom
a Atom
cARDINAL CInt
propModeReplace [a -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n]

setCurrentDesktop :: (Integral a) => a -> X ()
setCurrentDesktop :: forall a. Integral a => a -> X ()
setCurrentDesktop a
i = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Atom
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_CURRENT_DESKTOP"
    Atom
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
r Atom
a Atom
cARDINAL CInt
propModeReplace [a -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i]

setDesktopNames :: [String] -> X ()
setDesktopNames :: [WorkspaceId] -> X ()
setDesktopNames [WorkspaceId]
names = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    -- Names thereof
    Atom
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
    Atom
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_DESKTOP_NAMES"
    Atom
c <- WorkspaceId -> X Atom
getAtom WorkspaceId
"UTF8_STRING"
    let names' :: [CChar]
names' = (Word8 -> CChar) -> [Word8] -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> [CChar]) -> [Word8] -> [CChar]
forall a b. (a -> b) -> a -> b
$ (WorkspaceId -> [Word8]) -> [WorkspaceId] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++[Word8
0]) ([Word8] -> [Word8])
-> (WorkspaceId -> [Word8]) -> WorkspaceId -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> [Word8]
encode) [WorkspaceId]
names
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CChar] -> IO ()
changeProperty8 Display
dpy Atom
r Atom
a Atom
c CInt
propModeReplace [CChar]
names'

setClientList :: [Window] -> X ()
setClientList :: [Atom] -> X ()
setClientList [Atom]
wins = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Atom
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
    Atom
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_CLIENT_LIST"
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
r Atom
a Atom
wINDOW CInt
propModeReplace ((Atom -> CLong) -> [Atom] -> [CLong]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Atom -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Atom]
wins)

setClientListStacking :: [Window] -> X ()
setClientListStacking :: [Atom] -> X ()
setClientListStacking [Atom]
wins = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Atom
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
    Atom
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_CLIENT_LIST_STACKING"
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
r Atom
a Atom
wINDOW CInt
propModeReplace ((Atom -> CLong) -> [Atom] -> [CLong]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Atom -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Atom]
wins)

setWindowDesktop :: (Integral a) => Window -> a -> X ()
setWindowDesktop :: forall a. Integral a => Atom -> a -> X ()
setWindowDesktop Atom
win a
i = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Atom
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_DESKTOP"
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
win Atom
a Atom
cARDINAL CInt
propModeReplace [a -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i]

setActiveWindow :: Window -> X ()
setActiveWindow :: Atom -> X ()
setActiveWindow Atom
w = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Atom
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
    Atom
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_ACTIVE_WINDOW"
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
r Atom
a Atom
wINDOW CInt
propModeReplace [Atom -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Atom
w]

setDesktopViewport :: [Position] -> X ()
setDesktopViewport :: [Position] -> X ()
setDesktopViewport [Position]
positions = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Atom
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
    Atom
a <- IO Atom -> X Atom
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Atom -> X Atom) -> IO Atom -> X Atom
forall a b. (a -> b) -> a -> b
$ Display -> WorkspaceId -> Bool -> IO Atom
internAtom Display
dpy WorkspaceId
"_NET_DESKTOP_VIEWPORT" Bool
True
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
r Atom
a Atom
cARDINAL CInt
propModeReplace ((Position -> CLong) -> [Position] -> [CLong]
forall a b. (a -> b) -> [a] -> [b]
map Position -> CLong
forall a b. (Integral a, Num b) => a -> b
fi [Position]
positions)

setSupported :: X ()
setSupported :: X ()
setSupported = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Atom
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
    Atom
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_SUPPORTED"
    [Atom]
supp <- (WorkspaceId -> X Atom) -> [WorkspaceId] -> X [Atom]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM WorkspaceId -> X Atom
getAtom [WorkspaceId
"_NET_WM_STATE_HIDDEN"
                         ,WorkspaceId
"_NET_WM_STATE_DEMANDS_ATTENTION"
                         ,WorkspaceId
"_NET_NUMBER_OF_DESKTOPS"
                         ,WorkspaceId
"_NET_CLIENT_LIST"
                         ,WorkspaceId
"_NET_CLIENT_LIST_STACKING"
                         ,WorkspaceId
"_NET_CURRENT_DESKTOP"
                         ,WorkspaceId
"_NET_DESKTOP_NAMES"
                         ,WorkspaceId
"_NET_ACTIVE_WINDOW"
                         ,WorkspaceId
"_NET_WM_DESKTOP"
                         ,WorkspaceId
"_NET_WM_STRUT"
                         ,WorkspaceId
"_NET_DESKTOP_VIEWPORT"
                         ]
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
r Atom
a Atom
aTOM CInt
propModeReplace ((Atom -> CLong) -> [Atom] -> [CLong]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Atom -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Atom]
supp)

    WorkspaceId -> X ()
setWMName WorkspaceId
"xmonad"

-- TODO: use in SetWMName, UrgencyHook
addSupported :: [String] -> X ()
addSupported :: [WorkspaceId] -> X ()
addSupported [WorkspaceId]
props = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Atom
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
    Atom
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_SUPPORTED"
    [CLong]
newSupportedList <- (WorkspaceId -> X CLong) -> [WorkspaceId] -> X [CLong]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Atom -> CLong) -> X Atom -> X CLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Atom -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X Atom -> X CLong)
-> (WorkspaceId -> X Atom) -> WorkspaceId -> X CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> X Atom
getAtom) [WorkspaceId]
props
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ do
        [CLong]
supportedList <- [[CLong]] -> [CLong]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[CLong]] -> [CLong])
-> (Maybe [CLong] -> [[CLong]]) -> Maybe [CLong] -> [CLong]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [CLong] -> [[CLong]]
forall a. Maybe a -> [a]
maybeToList (Maybe [CLong] -> [CLong]) -> IO (Maybe [CLong]) -> IO [CLong]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Atom -> Atom -> IO (Maybe [CLong])
getWindowProperty32 Display
dpy Atom
a Atom
r
        Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
r Atom
a Atom
aTOM CInt
propModeReplace ([CLong] -> [CLong]
forall a. Eq a => [a] -> [a]
nub ([CLong] -> [CLong]) -> [CLong] -> [CLong]
forall a b. (a -> b) -> a -> b
$ [CLong]
newSupportedList [CLong] -> [CLong] -> [CLong]
forall a. [a] -> [a] -> [a]
++ [CLong]
supportedList)

setFullscreenSupported :: X ()
setFullscreenSupported :: X ()
setFullscreenSupported = [WorkspaceId] -> X ()
addSupported [WorkspaceId
"_NET_WM_STATE", WorkspaceId
"_NET_WM_STATE_FULLSCREEN"]