{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternGuards #-}
module XMonad.Hooks.EwmhDesktops (
ewmh,
ewmhFullscreen,
ewmhDesktopsManageHook,
ewmhDesktopsMaybeManageHook,
addEwmhWorkspaceSort, setEwmhWorkspaceSort,
addEwmhWorkspaceRename, setEwmhWorkspaceRename,
setEwmhActivateHook,
setEwmhFullscreenHooks,
disableEwmhManageDesktopViewport,
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
ewmh :: XConfig a -> XConfig a
ewmh :: forall (a :: * -> *). XConfig a -> XConfig a
ewmh XConfig a
c = XConfig a
c { startupHook = ewmhDesktopsStartup <> startupHook c
, handleEventHook = ewmhDesktopsEventHook <> handleEventHook c
, logHook = ewmhDesktopsLogHook <> logHook c }
data EwmhDesktopsConfig =
EwmhDesktopsConfig
{ EwmhDesktopsConfig -> X WorkspaceSort
workspaceSort :: X WorkspaceSort
, EwmhDesktopsConfig -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename :: X (String -> WindowSpace -> String)
, EwmhDesktopsConfig -> Query (Endo WindowSet)
activateHook :: ManageHook
, EwmhDesktopsConfig
-> (Query (Endo WindowSet), Query (Endo WindowSet))
fullscreenHooks :: (ManageHook, ManageHook)
, EwmhDesktopsConfig -> Bool
manageDesktopViewport :: Bool
}
instance Default EwmhDesktopsConfig where
def :: EwmhDesktopsConfig
def = EwmhDesktopsConfig
{ workspaceSort :: X WorkspaceSort
workspaceSort = X WorkspaceSort
getSortByIndex
, workspaceRename :: X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename = (WorkspaceId -> WindowSpace -> WorkspaceId)
-> X (WorkspaceId -> WindowSpace -> WorkspaceId)
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkspaceId -> WindowSpace -> WorkspaceId
forall a. a -> WindowSpace -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, activateHook :: Query (Endo WindowSet)
activateHook = Query (Endo WindowSet)
doFocus
, fullscreenHooks :: (Query (Endo WindowSet), Query (Endo WindowSet))
fullscreenHooks = (Query (Endo WindowSet)
doFullFloat, Query (Endo WindowSet)
doSink)
, manageDesktopViewport :: Bool
manageDesktopViewport = Bool
True
}
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 = liftA2 (.) f (workspaceSort c) }
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 = f }
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 = liftA2 (<=<) f (workspaceRename c) }
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 = f }
setEwmhActivateHook :: ManageHook -> XConfig l -> XConfig l
setEwmhActivateHook :: forall (l :: * -> *).
Query (Endo WindowSet) -> XConfig l -> XConfig l
setEwmhActivateHook Query (Endo WindowSet)
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 = h }
setEwmhFullscreenHooks :: ManageHook -> ManageHook -> XConfig l -> XConfig l
setEwmhFullscreenHooks :: forall (l :: * -> *).
Query (Endo WindowSet)
-> Query (Endo WindowSet) -> XConfig l -> XConfig l
setEwmhFullscreenHooks Query (Endo WindowSet)
f Query (Endo WindowSet)
uf = (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{ fullscreenHooks = (f, uf) }
disableEwmhManageDesktopViewport :: XConfig l -> XConfig l
disableEwmhManageDesktopViewport :: forall (a :: * -> *). XConfig a -> XConfig a
disableEwmhManageDesktopViewport = (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{ manageDesktopViewport = False }
{-# DEPRECATED ewmhDesktopsStartup "Use ewmh instead." #-}
ewmhDesktopsStartup :: X ()
ewmhDesktopsStartup :: X ()
ewmhDesktopsStartup = X ()
setSupported
{-# 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'
{-# 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 = (f .) <$> workspaceSort def }
{-# 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'
{-# 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 = (f .) <$> workspaceSort def }
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
$c== :: DesktopNames -> DesktopNames -> Bool
== :: DesktopNames -> DesktopNames -> Bool
$c/= :: DesktopNames -> DesktopNames -> Bool
/= :: DesktopNames -> DesktopNames -> Bool
Eq
instance ExtensionClass DesktopNames where initialValue :: DesktopNames
initialValue = [WorkspaceId] -> DesktopNames
DesktopNames []
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
$c== :: ClientList -> ClientList -> Bool
== :: ClientList -> ClientList -> Bool
$c/= :: ClientList -> ClientList -> Bool
/= :: ClientList -> ClientList -> Bool
Eq
instance ExtensionClass ClientList where initialValue :: ClientList
initialValue = [Atom] -> ClientList
ClientList [Atom
none]
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
$c== :: ClientListStacking -> ClientListStacking -> Bool
== :: ClientListStacking -> ClientListStacking -> Bool
$c/= :: ClientListStacking -> ClientListStacking -> Bool
/= :: ClientListStacking -> ClientListStacking -> Bool
Eq
instance ExtensionClass ClientListStacking where initialValue :: ClientListStacking
initialValue = [Atom] -> ClientListStacking
ClientListStacking [Atom
none]
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
$c== :: CurrentDesktop -> CurrentDesktop -> Bool
== :: CurrentDesktop -> CurrentDesktop -> Bool
$c/= :: CurrentDesktop -> CurrentDesktop -> Bool
/= :: 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)
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
$c== :: WindowDesktops -> WindowDesktops -> Bool
== :: WindowDesktops -> WindowDesktops -> Bool
$c/= :: WindowDesktops -> WindowDesktops -> Bool
/= :: 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))
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
$c== :: ActiveWindow -> ActiveWindow -> Bool
== :: ActiveWindow -> ActiveWindow -> Bool
$c/= :: ActiveWindow -> ActiveWindow -> Bool
/= :: 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)
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
$cshowsPrec :: Int -> MonitorTags -> ShowS
showsPrec :: Int -> MonitorTags -> ShowS
$cshow :: MonitorTags -> WorkspaceId
show :: MonitorTags -> WorkspaceId
$cshowList :: [MonitorTags] -> ShowS
showList :: [MonitorTags] -> ShowS
Show,MonitorTags -> MonitorTags -> Bool
(MonitorTags -> MonitorTags -> Bool)
-> (MonitorTags -> MonitorTags -> Bool) -> Eq MonitorTags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonitorTags -> MonitorTags -> Bool
== :: MonitorTags -> MonitorTags -> Bool
$c/= :: MonitorTags -> MonitorTags -> Bool
/= :: MonitorTags -> MonitorTags -> Bool
Eq)
instance ExtensionClass MonitorTags where initialValue :: MonitorTags
initialValue = [WorkspaceId] -> MonitorTags
MonitorTags []
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 :: EwmhDesktopsConfig -> X WorkspaceSort
workspaceSort :: X WorkspaceSort
workspaceSort, X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename :: EwmhDesktopsConfig -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename :: X (WorkspaceId -> WindowSpace -> WorkspaceId)
workspaceRename, Bool
manageDesktopViewport :: EwmhDesktopsConfig -> Bool
manageDesktopViewport :: Bool
manageDesktopViewport} = (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
sort' <- X WorkspaceSort
workspaceSort
let 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
rename <- workspaceRename
let 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 ]
whenChanged (DesktopNames desktopNames) $ do
setNumberOfDesktops (length desktopNames)
setDesktopNames desktopNames
let 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
whenChanged (ClientList clientList) $ setClientList clientList
let clientListStacking =
let wsInFocusOrder :: [WindowSpace]
wsInFocusOrder = WindowSet -> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.hidden WindowSet
s
[WindowSpace] -> WorkspaceSort
forall a. [a] -> [a] -> [a]
++ ((Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> WindowSpace)
-> [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail]
-> [WindowSpace]
forall a b. (a -> b) -> [a] -> [b]
map 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]
-> [WindowSpace])
-> (WindowSet
-> [Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail])
-> WindowSet
-> [WindowSpace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
[WindowSpace] -> WorkspaceSort
forall a. [a] -> [a] -> [a]
++ [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
-> WindowSpace)
-> Screen WorkspaceId (Layout Atom) Atom ScreenId ScreenDetail
-> WindowSpace
forall a b. (a -> b) -> a -> b
$ 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]
stackWindows :: Stack a -> [a]
stackWindows (W.Stack a
cur [a]
up [a]
down) = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
up [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
down [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
cur]
workspaceWindows :: Workspace i l a -> [a]
workspaceWindows = [a] -> (Stack a -> [a]) -> Maybe (Stack a) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack a -> [a]
forall {a}. Stack a -> [a]
stackWindows (Maybe (Stack a) -> [a])
-> (Workspace i l a -> Maybe (Stack a)) -> Workspace i l a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack
uniqueKeepLast :: [Atom] -> [Atom]
uniqueKeepLast = [Atom] -> [Atom]
forall a. [a] -> [a]
reverse ([Atom] -> [Atom]) -> ([Atom] -> [Atom]) -> [Atom] -> [Atom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Atom] -> [Atom]
forall a. Eq a => [a] -> [a]
nub ([Atom] -> [Atom]) -> ([Atom] -> [Atom]) -> [Atom] -> [Atom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Atom] -> [Atom]
forall a. [a] -> [a]
reverse
in [Atom] -> [Atom]
uniqueKeepLast ([Atom] -> [Atom]) -> [Atom] -> [Atom]
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> [Atom]) -> [WindowSpace] -> [Atom]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap WindowSpace -> [Atom]
forall {i} {l} {a}. Workspace i l a -> [a]
workspaceWindows [WindowSpace]
wsInFocusOrder
whenChanged (ClientListStacking clientListStacking) $
setClientListStacking clientListStacking
let 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
whenChanged (CurrentDesktop $ fromMaybe 0 current) $
mapM_ setCurrentDesktop current
let 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
whenChanged (WindowDesktops windowDesktops) $
mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops)
let 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)
whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow'
when manageDesktopViewport $ do
let 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 = (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
whenChanged (MonitorTags currentTags) $ mkViewPorts s (map W.tag ws)
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
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 :: EwmhDesktopsConfig -> X WorkspaceSort
workspaceSort :: X WorkspaceSort
workspaceSort, Query (Endo WindowSet)
activateHook :: EwmhDesktopsConfig -> Query (Endo WindowSet)
activateHook :: Query (Endo WindowSet)
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
sort' <- X WorkspaceSort
workspaceSort
let 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
a_cd <- getAtom "_NET_CURRENT_DESKTOP"
a_d <- getAtom "_NET_WM_DESKTOP"
a_aw <- getAtom "_NET_ACTIVE_WINDOW"
a_cw <- getAtom "_NET_CLOSE_WINDOW"
if | mt == a_cw ->
killWindow w
| mt == a_cd, n : _ <- d, Just ww <- ws !? fi n ->
if W.currentTag s == W.tag ww then mempty else windows $ W.view (W.tag ww)
| mt == a_cd ->
trace $ "Bad _NET_CURRENT_DESKTOP with data=" ++ show d
| not (w `W.member` s) ->
mempty
| mt == a_d, n : _ <- d, Just ww <- ws !? fi n ->
if W.findTag w s == Just (W.tag ww) then mempty else windows $ W.shiftWin (W.tag ww) w
| mt == a_d ->
trace $ "Bad _NET_WM_DESKTOP with data=" ++ show d
| mt == a_aw, 2 : _ <- d ->
if W.peek s == Just w then mempty else windows $ W.focusWindow w
| mt == a_aw -> do
if W.peek s == Just w then mempty else windows . appEndo =<< runQuery activateHook w
| otherwise ->
mempty
mempty
ewmhDesktopsEventHook' Event
_ EwmhDesktopsConfig
_ = X All
forall a. Monoid a => a
mempty
ewmhDesktopsManageHook :: ManageHook
ewmhDesktopsManageHook :: Query (Endo WindowSet)
ewmhDesktopsManageHook = Query (Maybe (Endo WindowSet)) -> Query (Endo WindowSet)
forall a (m :: * -> *). (Monoid a, Functor m) => m (Maybe a) -> m a
maybeToDefinite Query (Maybe (Endo WindowSet))
ewmhDesktopsMaybeManageHook
ewmhDesktopsMaybeManageHook :: MaybeManageHook
ewmhDesktopsMaybeManageHook :: Query (Maybe (Endo WindowSet))
ewmhDesktopsMaybeManageHook = Query (Maybe Int)
desktop Query (Maybe Int)
-> (Maybe Int -> Query (Maybe (Endo WindowSet)))
-> Query (Maybe (Endo WindowSet))
forall a b. Query a -> (a -> Query b) -> Query b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Query (Endo WindowSet))
-> Maybe Int -> Query (Maybe (Endo WindowSet))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Int -> Query (Endo WindowSet)
doShiftI
where
doShiftI :: Int -> ManageHook
doShiftI :: Int -> Query (Endo WindowSet)
doShiftI Int
d = do
sort' <- X WorkspaceSort -> Query WorkspaceSort
forall a. X a -> Query a
liftX (X WorkspaceSort -> Query WorkspaceSort)
-> ((EwmhDesktopsConfig -> X WorkspaceSort) -> X WorkspaceSort)
-> (EwmhDesktopsConfig -> X WorkspaceSort)
-> Query WorkspaceSort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EwmhDesktopsConfig -> X WorkspaceSort) -> X WorkspaceSort
forall (m :: * -> *) a b.
(MonadReader XConf m, Typeable a, Default a) =>
(a -> m b) -> m b
XC.withDef ((EwmhDesktopsConfig -> X WorkspaceSort) -> Query WorkspaceSort)
-> (EwmhDesktopsConfig -> X WorkspaceSort) -> Query WorkspaceSort
forall a b. (a -> b) -> a -> b
$ \EwmhDesktopsConfig{X WorkspaceSort
workspaceSort :: EwmhDesktopsConfig -> X WorkspaceSort
workspaceSort :: X WorkspaceSort
workspaceSort} -> X WorkspaceSort
workspaceSort
ws <- liftX . gets $ map W.tag . sort' . W.workspaces . windowset
maybe idHook doShift $ ws !? d
ewmhFullscreen :: XConfig a -> XConfig a
ewmhFullscreen :: forall (a :: * -> *). XConfig a -> XConfig a
ewmhFullscreen XConfig a
c = XConfig a
c { startupHook = startupHook c <> fullscreenStartup
, handleEventHook = handleEventHook c <> fullscreenEventHook }
{-# DEPRECATED fullscreenStartup "Use ewmhFullscreen instead." #-}
fullscreenStartup :: X ()
fullscreenStartup :: X ()
fullscreenStartup = X ()
setFullscreenSupported
{-# DEPRECATED fullscreenEventHook "Use ewmhFullscreen instead." #-}
fullscreenEventHook :: Event -> X All
fullscreenEventHook :: Event -> X All
fullscreenEventHook = (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
fullscreenEventHook'
fullscreenEventHook' :: Event -> EwmhDesktopsConfig -> X All
fullscreenEventHook' :: Event -> EwmhDesktopsConfig -> X All
fullscreenEventHook'
ClientMessageEvent{ev_event_display :: Event -> Display
ev_event_display = Display
dpy, ev_window :: Event -> Atom
ev_window = Atom
win, ev_message_type :: Event -> Atom
ev_message_type = Atom
typ, ev_data :: Event -> [CInt]
ev_data = CInt
action:[CInt]
dats}
EwmhDesktopsConfig{fullscreenHooks :: EwmhDesktopsConfig
-> (Query (Endo WindowSet), Query (Endo WindowSet))
fullscreenHooks = (Query (Endo WindowSet)
fullscreenHook, Query (Endo WindowSet)
unFullscreenHook)} = do
managed <- Atom -> X Bool
isClient Atom
win
wmstate <- getAtom "_NET_WM_STATE"
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
wstate <- fromMaybe [] <$> getProp32 wmstate win
let isFull = Atom -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Atom
fullsc CLong -> [CLong] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLong]
wstate
remove = CInt
0
add = CInt
1
toggle = CInt
2
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)
when (managed && typ == wmstate && fi fullsc `elem` dats) $ do
when (not isFull && (action == add || action == toggle)) $ do
chWstate (fi fullsc:)
windows . appEndo =<< runQuery fullscreenHook win
when (isFull && (action == remove || action == toggle)) $ do
chWstate $ delete (fi fullsc)
windows . appEndo =<< runQuery unFullscreenHook win
return $ All True
fullscreenEventHook' Event
_ EwmhDesktopsConfig
_ = All -> X All
forall a. a -> X a
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
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_NUMBER_OF_DESKTOPS"
r <- asks theRoot
io $ changeProperty32 dpy r a cARDINAL propModeReplace [fromIntegral 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
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_CURRENT_DESKTOP"
r <- asks theRoot
io $ changeProperty32 dpy r a cARDINAL propModeReplace [fromIntegral 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
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
a <- getAtom "_NET_DESKTOP_NAMES"
c <- getAtom "UTF8_STRING"
let 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 $ changeProperty8 dpy r a c propModeReplace 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
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
a <- getAtom "_NET_CLIENT_LIST"
io $ changeProperty32 dpy r a wINDOW propModeReplace (fmap fromIntegral 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
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
a <- getAtom "_NET_CLIENT_LIST_STACKING"
io $ changeProperty32 dpy r a wINDOW propModeReplace (fmap fromIntegral 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
a <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_DESKTOP"
io $ changeProperty32 dpy win a cARDINAL propModeReplace [fromIntegral 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
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
a <- getAtom "_NET_ACTIVE_WINDOW"
io $ changeProperty32 dpy r a wINDOW propModeReplace [fromIntegral 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
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
a <- io $ internAtom dpy "_NET_DESKTOP_VIEWPORT" True
io $ changeProperty32 dpy r a cARDINAL propModeReplace (map fi 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
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
a <- getAtom "_NET_SUPPORTED"
supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"
,"_NET_WM_STATE_DEMANDS_ATTENTION"
,"_NET_NUMBER_OF_DESKTOPS"
,"_NET_CLIENT_LIST"
,"_NET_CLIENT_LIST_STACKING"
,"_NET_CURRENT_DESKTOP"
,"_NET_DESKTOP_NAMES"
,"_NET_ACTIVE_WINDOW"
,"_NET_WM_DESKTOP"
,"_NET_WM_STRUT"
,"_NET_WM_STRUT_PARTIAL"
,"_NET_DESKTOP_VIEWPORT"
]
io $ changeProperty32 dpy r a aTOM propModeReplace (fmap fromIntegral supp)
setWMName "xmonad"
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
r <- (XConf -> Atom) -> X Atom
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
a <- getAtom "_NET_SUPPORTED"
newSupportedList <- mapM (fmap fromIntegral . getAtom) props
io $ do
supportedList <- join . maybeToList <$> getWindowProperty32 dpy a r
changeProperty32 dpy r a aTOM propModeReplace (nub $ newSupportedList ++ supportedList)
setFullscreenSupported :: X ()
setFullscreenSupported :: X ()
setFullscreenSupported = [WorkspaceId] -> X ()
addSupported [WorkspaceId
"_NET_WM_STATE", WorkspaceId
"_NET_WM_STATE_FULLSCREEN"]