module XMonad.Hooks.EwmhDesktops (
ewmh,
ewmhDesktopsStartup,
ewmhDesktopsLogHook,
ewmhDesktopsLogHookCustom,
ewmhDesktopsEventHook,
ewmhDesktopsEventHookCustom,
fullscreenEventHook
) where
import Codec.Binary.UTF8.String (encode)
import Control.Applicative((<$>))
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Map.Strict as M
import System.IO.Unsafe
import XMonad
import Control.Monad
import qualified XMonad.StackSet as W
import XMonad.Hooks.SetWMName
import qualified XMonad.Util.ExtensibleState as E
import XMonad.Util.XUtils (fi)
import XMonad.Util.WorkspaceCompare
import XMonad.Util.WindowProperties (getProp32)
ewmh :: XConfig a -> XConfig a
ewmh :: XConfig a -> XConfig a
ewmh c :: 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. Monoid a => a -> a -> a
+++ X ()
ewmhDesktopsStartup
, 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. Monoid a => a -> a -> a
+++ Event -> X All
ewmhDesktopsEventHook
, logHook :: X ()
logHook = XConfig a -> X ()
forall (l :: * -> *). XConfig l -> X ()
logHook XConfig a
c X () -> X () -> X ()
forall a. Monoid a => a -> a -> a
+++ X ()
ewmhDesktopsLogHook }
where x :: a
x +++ :: a -> a -> a
+++ y :: a
y = a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
y a
x
ewmhDesktopsStartup :: X ()
ewmhDesktopsStartup :: X ()
ewmhDesktopsStartup = X ()
setSupported
ewmhDesktopsLogHook :: X ()
ewmhDesktopsLogHook :: X ()
ewmhDesktopsLogHook = ([WindowSpace] -> [WindowSpace]) -> X ()
ewmhDesktopsLogHookCustom [WindowSpace] -> [WindowSpace]
forall a. a -> a
id
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 = [String] -> 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
/= :: ClientList -> ClientList -> Bool
$c/= :: ClientList -> ClientList -> Bool
== :: ClientList -> ClientList -> Bool
$c== :: ClientList -> ClientList -> Bool
Eq)
instance ExtensionClass ClientList where
initialValue :: ClientList
initialValue = [Window] -> ClientList
ClientList []
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 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
/= :: WindowDesktops -> WindowDesktops -> Bool
$c/= :: WindowDesktops -> WindowDesktops -> Bool
== :: WindowDesktops -> WindowDesktops -> Bool
$c== :: WindowDesktops -> WindowDesktops -> Bool
Eq)
instance ExtensionClass WindowDesktops where
initialValue :: WindowDesktops
initialValue = Map Window Int -> WindowDesktops
WindowDesktops Map Window Int
forall k a. Map k a
M.empty
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 = Window -> ActiveWindow
ActiveWindow Window
none
whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged :: a -> X () -> X ()
whenChanged v :: a
v action :: X ()
action = do
a
v0 <- X a
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
E.get
Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v0) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
X ()
action
a -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
E.put a
v
ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X ()
ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X ()
ewmhDesktopsLogHookCustom f :: [WindowSpace] -> [WindowSpace]
f = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \s :: WindowSet
s -> do
[WindowSpace] -> [WindowSpace]
sort' <- X ([WindowSpace] -> [WindowSpace])
getSortByIndex
let ws :: [WindowSpace]
ws = [WindowSpace] -> [WindowSpace]
f ([WindowSpace] -> [WindowSpace]) -> [WindowSpace] -> [WindowSpace]
forall a b. (a -> b) -> a -> b
$ [WindowSpace] -> [WindowSpace]
sort' ([WindowSpace] -> [WindowSpace]) -> [WindowSpace] -> [WindowSpace]
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
let desktopNames :: [String]
desktopNames = (WindowSpace -> String) -> [WindowSpace] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> String
forall i l a. Workspace i l a -> i
W.tag [WindowSpace]
ws
DesktopNames -> X () -> X ()
forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged ([String] -> DesktopNames
DesktopNames [String]
desktopNames) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
Int -> X ()
forall a. Integral a => a -> X ()
setNumberOfDesktops ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
desktopNames)
[String] -> X ()
setDesktopNames [String]
desktopNames
let clientList :: [Window]
clientList = [Window] -> [Window]
forall a. Eq a => [a] -> [a]
nub ([Window] -> [Window])
-> ([WindowSpace] -> [Window]) -> [WindowSpace] -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSpace -> [Window]) -> [WindowSpace] -> [Window]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Window]
-> (Stack Window -> [Window]) -> Maybe (Stack Window) -> [Window]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(W.Stack x :: Window
x l :: [Window]
l r :: [Window]
r) -> [Window] -> [Window]
forall a. [a] -> [a]
reverse [Window]
l [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
r [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window
x]) (Maybe (Stack Window) -> [Window])
-> (WindowSpace -> Maybe (Stack Window)) -> WindowSpace -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) ([WindowSpace] -> [Window]) -> [WindowSpace] -> [Window]
forall a b. (a -> b) -> a -> b
$ [WindowSpace]
ws
ClientList -> X () -> X ()
forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged ([Window] -> ClientList
ClientList [Window]
clientList) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ [Window] -> X ()
setClientList [Window]
clientList
let maybeCurrent' :: Maybe String
maybeCurrent' = WindowSpace -> String
forall i l a. Workspace i l a -> i
W.tag (WindowSpace -> String) -> Maybe WindowSpace -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WindowSpace] -> Maybe WindowSpace
forall a. [a] -> Maybe a
listToMaybe ([WindowSpace] -> [WindowSpace]
f [Screen String (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace)
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
s])
current :: Maybe Int
current = Maybe (Maybe Int) -> Maybe Int
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((String -> [String] -> Maybe Int)
-> [String] -> String -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex ((WindowSpace -> String) -> [WindowSpace] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> String
forall i l a. Workspace i l a -> i
W.tag [WindowSpace]
ws) (String -> Maybe Int) -> Maybe String -> Maybe (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
maybeCurrent')
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 0 Maybe Int
current) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
(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
let windowDesktops :: Map Window Int
windowDesktops =
let f :: a -> Workspace i l k -> Map k a
f wsId :: a
wsId workspace :: 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 Window Int] -> Map Window Int
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Map Window Int] -> Map Window Int)
-> [Map Window Int] -> Map Window Int
forall a b. (a -> b) -> a -> b
$ (Int -> WindowSpace -> Map Window Int)
-> [Int] -> [WindowSpace] -> [Map Window Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> WindowSpace -> Map Window Int
forall k a i l. Ord k => a -> Workspace i l k -> Map k a
f [0..] [WindowSpace]
ws
WindowDesktops -> X () -> X ()
forall a. (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged (Map Window Int -> WindowDesktops
WindowDesktops Map Window Int
windowDesktops) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
((Window, Int) -> X ()) -> [(Window, Int)] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Window -> Int -> X ()) -> (Window, Int) -> X ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Window -> Int -> X ()
forall a. Integral a => Window -> a -> X ()
setWindowDesktop) (Map Window Int -> [(Window, Int)]
forall k a. Map k a -> [(k, a)]
M.toList Map Window Int
windowDesktops)
let activeWindow' :: Window
activeWindow' = Window -> Maybe Window -> Window
forall a. a -> Maybe a -> a
fromMaybe Window
none (WindowSet -> Maybe Window
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 (Window -> ActiveWindow
ActiveWindow Window
activeWindow') (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> X ()
setActiveWindow Window
activeWindow'
ewmhDesktopsEventHook :: Event -> X All
ewmhDesktopsEventHook :: Event -> X All
ewmhDesktopsEventHook = ([WindowSpace] -> [WindowSpace]) -> Event -> X All
ewmhDesktopsEventHookCustom [WindowSpace] -> [WindowSpace]
forall a. a -> a
id
ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All
ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All
ewmhDesktopsEventHookCustom f :: [WindowSpace] -> [WindowSpace]
f e :: Event
e = ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
handle [WindowSpace] -> [WindowSpace]
f Event
e X () -> X All -> X All
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
handle f :: [WindowSpace] -> [WindowSpace]
f (ClientMessageEvent {
ev_window :: Event -> Window
ev_window = Window
w,
ev_message_type :: Event -> Window
ev_message_type = Window
mt,
ev_data :: Event -> [CInt]
ev_data = [CInt]
d
}) = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \s :: WindowSet
s -> do
[WindowSpace] -> [WindowSpace]
sort' <- X ([WindowSpace] -> [WindowSpace])
getSortByIndex
let ws :: [WindowSpace]
ws = [WindowSpace] -> [WindowSpace]
f ([WindowSpace] -> [WindowSpace]) -> [WindowSpace] -> [WindowSpace]
forall a b. (a -> b) -> a -> b
$ [WindowSpace] -> [WindowSpace]
sort' ([WindowSpace] -> [WindowSpace]) -> [WindowSpace] -> [WindowSpace]
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
Window
a_cd <- String -> X Window
getAtom "_NET_CURRENT_DESKTOP"
Window
a_d <- String -> X Window
getAtom "_NET_WM_DESKTOP"
Window
a_aw <- String -> X Window
getAtom "_NET_ACTIVE_WINDOW"
Window
a_cw <- String -> X Window
getAtom "_NET_CLOSE_WINDOW"
[Window]
a_ignore <- (String -> X Window) -> [String] -> X [Window]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> X Window
getAtom ["XMONAD_TIMER"]
if Window
mt Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
a_cd then do
let n :: CInt
n = [CInt] -> CInt
forall a. [a] -> a
head [CInt]
d
if 0 CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
n Bool -> Bool -> Bool
&& CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [WindowSpace] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WindowSpace]
ws then
(WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ String -> 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 -> String
forall i l a. Workspace i l a -> i
W.tag ([WindowSpace]
ws [WindowSpace] -> Int -> WindowSpace
forall a. [a] -> Int -> a
!! CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
n))
else String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace (String -> X ()) -> String -> X ()
forall a b. (a -> b) -> a -> b
$ "Bad _NET_CURRENT_DESKTOP with data[0]="String -> String -> String
forall a. [a] -> [a] -> [a]
++CInt -> String
forall a. Show a => a -> String
show CInt
n
else if Window
mt Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
a_d then do
let n :: CInt
n = [CInt] -> CInt
forall a. [a] -> a
head [CInt]
d
if 0 CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
n Bool -> Bool -> Bool
&& CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [WindowSpace] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WindowSpace]
ws then
(WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ String -> Window -> 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 -> String
forall i l a. Workspace i l a -> i
W.tag ([WindowSpace]
ws [WindowSpace] -> Int -> WindowSpace
forall a. [a] -> Int -> a
!! CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
n)) Window
w
else String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace (String -> X ()) -> String -> X ()
forall a b. (a -> b) -> a -> b
$ "Bad _NET_DESKTOP with data[0]="String -> String -> String
forall a. [a] -> [a] -> [a]
++CInt -> String
forall a. Show a => a -> String
show CInt
n
else if Window
mt Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
a_aw then do
(WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> 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 Window
w
else if Window
mt Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
a_cw then do
Window -> X ()
killWindow Window
w
else if Window
mt Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
a_ignore then do
() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handle _ _ = () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fullscreenEventHook :: Event -> X All
fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent _ _ _ dpy :: Display
dpy win :: Window
win typ :: Window
typ (action :: CInt
action:dats :: [CInt]
dats)) = do
Window
wmstate <- String -> X Window
getAtom "_NET_WM_STATE"
Window
fullsc <- String -> X Window
getAtom "_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
`fmap` Window -> Window -> X (Maybe [CLong])
getProp32 Window
wmstate Window
win
let isFull :: Bool
isFull = Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Window
fullsc CLong -> [CLong] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLong]
wstate
remove :: CInt
remove = 0
add :: CInt
add = 1
toggle :: CInt
toggle = 2
ptype :: Window
ptype = 4
chWstate :: ([CLong] -> [CLong]) -> m ()
chWstate f :: [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 -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
win Window
wmstate Window
ptype CInt
propModeReplace ([CLong] -> [CLong]
f [CLong]
wstate)
Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
typ Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
wmstate Bool -> Bool -> Bool
&& Window -> CInt
forall a b. (Integral a, Num b) => a -> b
fi Window
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 (Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Window
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
$ Window -> 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 Window
win (RationalRect -> WindowSet -> WindowSet)
-> RationalRect -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect 0 0 1 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 (Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Window
fullsc)
(WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> 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 Window
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 _ = 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 :: a -> X ()
setNumberOfDesktops n :: 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
$ \dpy :: Display
dpy -> do
Window
a <- String -> X Window
getAtom "_NET_NUMBER_OF_DESKTOPS"
Window
c <- String -> X Window
getAtom "CARDINAL"
Window
r <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
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 -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
r Window
a Window
c CInt
propModeReplace [a -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n]
setCurrentDesktop :: (Integral a) => a -> X ()
setCurrentDesktop :: a -> X ()
setCurrentDesktop i :: 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
$ \dpy :: Display
dpy -> do
Window
a <- String -> X Window
getAtom "_NET_CURRENT_DESKTOP"
Window
c <- String -> X Window
getAtom "CARDINAL"
Window
r <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
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 -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
r Window
a Window
c CInt
propModeReplace [a -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i]
setDesktopNames :: [String] -> X ()
setDesktopNames :: [String] -> X ()
setDesktopNames names :: [String]
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
$ \dpy :: Display
dpy -> do
Window
r <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
Window
a <- String -> X Window
getAtom "_NET_DESKTOP_NAMES"
Window
c <- String -> X Window
getAtom "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
$ (String -> [Word8]) -> [String] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++[0]) ([Word8] -> [Word8]) -> (String -> [Word8]) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
encode) [String]
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 -> Window -> Window -> Window -> CInt -> [CChar] -> IO ()
changeProperty8 Display
dpy Window
r Window
a Window
c CInt
propModeReplace [CChar]
names'
setClientList :: [Window] -> X ()
setClientList :: [Window] -> X ()
setClientList wins :: [Window]
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
$ \dpy :: Display
dpy -> do
Window
r <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
Window
c <- String -> X Window
getAtom "WINDOW"
Window
a <- String -> X Window
getAtom "_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 -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
r Window
a Window
c CInt
propModeReplace ((Window -> CLong) -> [Window] -> [CLong]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Window]
wins)
Window
a' <- String -> X Window
getAtom "_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 -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
r Window
a' Window
c CInt
propModeReplace ((Window -> CLong) -> [Window] -> [CLong]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Window]
wins)
setWindowDesktop :: (Integral a) => Window -> a -> X ()
setWindowDesktop :: Window -> a -> X ()
setWindowDesktop win :: Window
win i :: 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
$ \dpy :: Display
dpy -> do
Window
a <- String -> X Window
getAtom "_NET_WM_DESKTOP"
Window
c <- String -> X Window
getAtom "CARDINAL"
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
win Window
a Window
c CInt
propModeReplace [a -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i]
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
$ \dpy :: Display
dpy -> do
Window
r <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
Window
a <- String -> X Window
getAtom "_NET_SUPPORTED"
Window
c <- String -> X Window
getAtom "ATOM"
[Window]
supp <- (String -> X Window) -> [String] -> X [Window]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> X Window
getAtom ["_NET_WM_STATE_HIDDEN"
,"_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"
]
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
r Window
a Window
c CInt
propModeReplace ((Window -> CLong) -> [Window] -> [CLong]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Window]
supp)
String -> X ()
setWMName "xmonad"
setActiveWindow :: Window -> X ()
setActiveWindow :: Window -> X ()
setActiveWindow w :: Window
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
$ \dpy :: Display
dpy -> do
Window
r <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
Window
a <- String -> X Window
getAtom "_NET_ACTIVE_WINDOW"
Window
c <- String -> X Window
getAtom "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 -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
r Window
a Window
c CInt
propModeReplace [Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Window
w]
Window
a' <- String -> X Window
getAtom "_NET_WM_STATE"
Window
c' <- String -> X Window
getAtom "ATOM"
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
w Window
a' Window
c' CInt
propModeAppend []