{-# OPTIONS_GHC -w #-}
{-# LANGUAGE CPP, NamedFieldPuns, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TupleSections, FlexibleContexts #-}
module Xmobar.Plugins.EWMH (EWMH(..)) where
import Control.Applicative (Applicative(..))
import Control.Monad.State
import Control.Monad.Reader
import Graphics.X11 hiding (Modifier, Color)
import Graphics.X11.Xlib.Extras
import Xmobar.Run.Exec
import Codec.Binary.UTF8.String as UTF8
import Foreign.C (CChar, CLong)
import Xmobar.X11.Events (nextEvent')
import Data.List (intersperse, intercalate)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
data EWMH = EWMH | EWMHFMT Component deriving (ReadPrec [EWMH]
ReadPrec EWMH
Int -> ReadS EWMH
ReadS [EWMH]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EWMH]
$creadListPrec :: ReadPrec [EWMH]
readPrec :: ReadPrec EWMH
$creadPrec :: ReadPrec EWMH
readList :: ReadS [EWMH]
$creadList :: ReadS [EWMH]
readsPrec :: Int -> ReadS EWMH
$creadsPrec :: Int -> ReadS EWMH
Read, Int -> EWMH -> ShowS
[EWMH] -> ShowS
EWMH -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EWMH] -> ShowS
$cshowList :: [EWMH] -> ShowS
show :: EWMH -> String
$cshow :: EWMH -> String
showsPrec :: Int -> EWMH -> ShowS
$cshowsPrec :: Int -> EWMH -> ShowS
Show)
instance Exec EWMH where
alias :: EWMH -> String
alias EWMH
EWMH = String
"EWMH"
start :: EWMH -> (String -> IO ()) -> IO ()
start EWMH
ew String -> IO ()
cb = forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
ep -> forall a. M a -> IO a
execM forall a b. (a -> b) -> a -> b
$ do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Display
display
Window
r <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Window
root
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
xSetErrorHandler
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
selectInput Display
d Window
r Window
propertyChangeMask
[(Window, Updater)]
handlers' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(String
a, Updater
h) -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (String -> M Window
getAtom String
a) (forall (m :: * -> *) a. Monad m => a -> m a
return Updater
h)) [(String, Updater)]
handlers
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Window
root) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Window, Updater)]
handlers'
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
cb forall b c a. (b -> c) -> (a -> b) -> a -> c
. EWMH -> EwmhState -> String
fmtOf EWMH
ew forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> XEventPtr -> IO ()
nextEvent' Display
d XEventPtr
ep
Event
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ XEventPtr -> IO Event
getEvent XEventPtr
ep
case Event
e of
PropertyEvent { ev_atom :: Event -> Window
ev_atom = Window
a, ev_window :: Event -> Window
ev_window = Window
w } ->
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Window
a [(Window, Updater)]
handlers' of
Just Updater
f -> Updater
f Window
w
Maybe Updater
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
defaultPP :: Component
defaultPP = Component -> [Component] -> Component
Sep (String -> Component
Text String
" : ") [ [WsOpt] -> Component
Workspaces [String -> String -> Modifier
Color String
"white" String
"black" Modifier -> WsType -> WsOpt
:% WsType
Current, Modifier
Hide Modifier -> WsType -> WsOpt
:% WsType
Empty]
, Component
Layout
, String -> String -> Modifier
Color String
"#00ee00" String
"" Modifier -> Component -> Component
:$ Int -> Modifier
Short Int
120 Modifier -> Component -> Component
:$ Component
WindowName]
fmtOf :: EWMH -> EwmhState -> String
fmtOf EWMH
EWMH = forall a b c. (a -> b -> c) -> b -> a -> c
flip EwmhState -> Component -> String
fmt Component
defaultPP
fmtOf (EWMHFMT Component
f) = forall a b c. (a -> b -> c) -> b -> a -> c
flip EwmhState -> Component -> String
fmt Component
f
sep :: [a] -> [[a]] -> [a]
sep :: forall a. [a] -> [[a]] -> [a]
sep [a]
x [[a]]
xs = forall a. [a] -> [[a]] -> [a]
intercalate [a]
x forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[a]]
xs
fmt :: EwmhState -> Component -> String
fmt :: EwmhState -> Component -> String
fmt EwmhState
e (Text String
s) = String
s
fmt EwmhState
e (Component
l :+ Component
r) = EwmhState -> Component -> String
fmt EwmhState
e Component
l forall a. [a] -> [a] -> [a]
++ EwmhState -> Component -> String
fmt EwmhState
e Component
r
fmt EwmhState
e (Modifier
m :$ Component
r) = Modifier -> ShowS
modifier Modifier
m forall a b. (a -> b) -> a -> b
$ EwmhState -> Component -> String
fmt EwmhState
e Component
r
fmt EwmhState
e (Sep Component
c [Component]
xs) = forall a. [a] -> [[a]] -> [a]
sep (EwmhState -> Component -> String
fmt EwmhState
e Component
c) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (EwmhState -> Component -> String
fmt EwmhState
e) [Component]
xs
fmt EwmhState
e Component
WindowName = Client -> String
windowName forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Client
initialClient (EwmhState -> Window
activeWindow EwmhState
e) (EwmhState -> Map Window Client
clients EwmhState
e)
fmt EwmhState
e Component
Layout = EwmhState -> String
layout EwmhState
e
fmt EwmhState
e (Workspaces [WsOpt]
opts) = forall a. [a] -> [[a]] -> [a]
sep String
" "
[forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (a -> b) -> a -> b
($) String
n [Modifier -> ShowS
modifier Modifier
m | (Modifier
m :% WsType
a) <- [WsOpt]
opts, WsType
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WsType]
as]
| (String
n, [WsType]
as) <- [(String, [WsType])]
attrs]
where
stats :: CLong -> [(WsType, Bool)]
stats CLong
i = [ (WsType
Current, CLong
i forall a. Eq a => a -> a -> Bool
== EwmhState -> CLong
currentDesktop EwmhState
e)
, (WsType
Empty, forall a. Ord a => a -> Set a -> Bool
Set.notMember CLong
i Set CLong
nonEmptys Bool -> Bool -> Bool
&& CLong
i forall a. Eq a => a -> a -> Bool
/= EwmhState -> CLong
currentDesktop EwmhState
e)
]
attrs :: [(String, [WsType])]
attrs :: [(String, [WsType])]
attrs = [(String
n, [WsType
s | (WsType
s, Bool
b) <- CLong -> [(WsType, Bool)]
stats CLong
i, Bool
b]) | (CLong
i, String
n) <- forall a b. [a] -> [b] -> [(a, b)]
zip [CLong
0 ..] (EwmhState -> [String]
desktopNames EwmhState
e)]
nonEmptys :: Set CLong
nonEmptys = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Client -> Set CLong
desktops forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ EwmhState -> Map Window Client
clients EwmhState
e
modifier :: Modifier -> String -> String
modifier :: Modifier -> ShowS
modifier Modifier
Hide = forall a b. a -> b -> a
const String
""
modifier (Color String
fg String
bg) = \String
x -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<fc=", String
fg, if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bg then String
"" else String
"," forall a. [a] -> [a] -> [a]
++ String
bg
, String
">", String
x, String
"</fc>"]
modifier (Short Int
n) = forall a. Int -> [a] -> [a]
take Int
n
modifier (Wrap String
l String
r) = \String
x -> String
l forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
r
data Component = Text String
| Component :+ Component
| Modifier :$ Component
| Sep Component [Component]
| WindowName
| Layout
| Workspaces [WsOpt]
deriving (ReadPrec [Component]
ReadPrec Component
Int -> ReadS Component
ReadS [Component]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Component]
$creadListPrec :: ReadPrec [Component]
readPrec :: ReadPrec Component
$creadPrec :: ReadPrec Component
readList :: ReadS [Component]
$creadList :: ReadS [Component]
readsPrec :: Int -> ReadS Component
$creadsPrec :: Int -> ReadS Component
Read, Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show)
infixr 0 :$
infixr 5 :+
data Modifier = Hide
| Color String String
| Short Int
| Wrap String String
deriving (ReadPrec [Modifier]
ReadPrec Modifier
Int -> ReadS Modifier
ReadS [Modifier]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Modifier]
$creadListPrec :: ReadPrec [Modifier]
readPrec :: ReadPrec Modifier
$creadPrec :: ReadPrec Modifier
readList :: ReadS [Modifier]
$creadList :: ReadS [Modifier]
readsPrec :: Int -> ReadS Modifier
$creadsPrec :: Int -> ReadS Modifier
Read, Int -> Modifier -> ShowS
[Modifier] -> ShowS
Modifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modifier] -> ShowS
$cshowList :: [Modifier] -> ShowS
show :: Modifier -> String
$cshow :: Modifier -> String
showsPrec :: Int -> Modifier -> ShowS
$cshowsPrec :: Int -> Modifier -> ShowS
Show)
data WsOpt = Modifier :% WsType
| WSep Component
deriving (ReadPrec [WsOpt]
ReadPrec WsOpt
Int -> ReadS WsOpt
ReadS [WsOpt]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WsOpt]
$creadListPrec :: ReadPrec [WsOpt]
readPrec :: ReadPrec WsOpt
$creadPrec :: ReadPrec WsOpt
readList :: ReadS [WsOpt]
$creadList :: ReadS [WsOpt]
readsPrec :: Int -> ReadS WsOpt
$creadsPrec :: Int -> ReadS WsOpt
Read, Int -> WsOpt -> ShowS
[WsOpt] -> ShowS
WsOpt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WsOpt] -> ShowS
$cshowList :: [WsOpt] -> ShowS
show :: WsOpt -> String
$cshow :: WsOpt -> String
showsPrec :: Int -> WsOpt -> ShowS
$cshowsPrec :: Int -> WsOpt -> ShowS
Show)
infixr 0 :%
data WsType = Current | Empty | Visible
deriving (ReadPrec [WsType]
ReadPrec WsType
Int -> ReadS WsType
ReadS [WsType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WsType]
$creadListPrec :: ReadPrec [WsType]
readPrec :: ReadPrec WsType
$creadPrec :: ReadPrec WsType
readList :: ReadS [WsType]
$creadList :: ReadS [WsType]
readsPrec :: Int -> ReadS WsType
$creadsPrec :: Int -> ReadS WsType
Read, Int -> WsType -> ShowS
[WsType] -> ShowS
WsType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WsType] -> ShowS
$cshowList :: [WsType] -> ShowS
show :: WsType -> String
$cshow :: WsType -> String
showsPrec :: Int -> WsType -> ShowS
$cshowsPrec :: Int -> WsType -> ShowS
Show, WsType -> WsType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WsType -> WsType -> Bool
$c/= :: WsType -> WsType -> Bool
== :: WsType -> WsType -> Bool
$c== :: WsType -> WsType -> Bool
Eq)
data EwmhConf = C { EwmhConf -> Window
root :: Window
, EwmhConf -> Display
display :: Display }
data EwmhState = S { EwmhState -> CLong
currentDesktop :: CLong
, EwmhState -> Window
activeWindow :: Window
, EwmhState -> [String]
desktopNames :: [String]
, EwmhState -> String
layout :: String
, EwmhState -> Map Window Client
clients :: Map Window Client }
deriving Int -> EwmhState -> ShowS
[EwmhState] -> ShowS
EwmhState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EwmhState] -> ShowS
$cshowList :: [EwmhState] -> ShowS
show :: EwmhState -> String
$cshow :: EwmhState -> String
showsPrec :: Int -> EwmhState -> ShowS
$cshowsPrec :: Int -> EwmhState -> ShowS
Show
data Client = Cl { Client -> String
windowName :: String
, Client -> Set CLong
desktops :: Set CLong }
deriving Int -> Client -> ShowS
[Client] -> ShowS
Client -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Client] -> ShowS
$cshowList :: [Client] -> ShowS
show :: Client -> String
$cshow :: Client -> String
showsPrec :: Int -> Client -> ShowS
$cshowsPrec :: Int -> Client -> ShowS
Show
getAtom :: String -> M Atom
getAtom :: String -> M Window
getAtom String
s = do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Display
display
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Window
internAtom Display
d String
s Bool
False
windowProperty32 :: String -> Window -> M (Maybe [CLong])
windowProperty32 :: String -> Window -> M (Maybe [CLong])
windowProperty32 String
s Window
w = do
C {Display
display :: Display
display :: EwmhConf -> Display
display} <- forall r (m :: * -> *). MonadReader r m => m r
ask
Window
a <- String -> M Window
getAtom String
s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO (Maybe [CLong])
getWindowProperty32 Display
display Window
a Window
w
windowProperty8 :: String -> Window -> M (Maybe [CChar])
windowProperty8 :: String -> Window -> M (Maybe [CChar])
windowProperty8 String
s Window
w = do
C {Display
display :: Display
display :: EwmhConf -> Display
display} <- forall r (m :: * -> *). MonadReader r m => m r
ask
Window
a <- String -> M Window
getAtom String
s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO (Maybe [CChar])
getWindowProperty8 Display
display Window
a Window
w
initialState :: EwmhState
initialState :: EwmhState
initialState = CLong
-> Window -> [String] -> String -> Map Window Client -> EwmhState
S CLong
0 Window
0 [] [] forall k a. Map k a
Map.empty
initialClient :: Client
initialClient :: Client
initialClient = String -> Set CLong -> Client
Cl String
"" forall a. Set a
Set.empty
handlers, clientHandlers :: [(String, Updater)]
handlers :: [(String, Updater)]
handlers = [ (String
"_NET_CURRENT_DESKTOP", Updater
updateCurrentDesktop)
, (String
"_NET_DESKTOP_NAMES", Updater
updateDesktopNames )
, (String
"_NET_ACTIVE_WINDOW", Updater
updateActiveWindow)
, (String
"_NET_CLIENT_LIST", forall {p}. p -> M ()
updateClientList)
] forall a. [a] -> [a] -> [a]
++ [(String, Updater)]
clientHandlers
clientHandlers :: [(String, Updater)]
clientHandlers = [ (String
"_NET_WM_NAME", Updater
updateName)
, (String
"_NET_WM_DESKTOP", Updater
updateDesktop) ]
newtype M a = M (ReaderT EwmhConf (StateT EwmhState IO) a)
deriving (Applicative M
forall a. a -> M a
forall a b. M a -> M b -> M b
forall a b. M a -> (a -> M b) -> M b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> M a
$creturn :: forall a. a -> M a
>> :: forall a b. M a -> M b -> M b
$c>> :: forall a b. M a -> M b -> M b
>>= :: forall a b. M a -> (a -> M b) -> M b
$c>>= :: forall a b. M a -> (a -> M b) -> M b
Monad, forall a b. a -> M b -> M a
forall a b. (a -> b) -> M a -> M b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> M b -> M a
$c<$ :: forall a b. a -> M b -> M a
fmap :: forall a b. (a -> b) -> M a -> M b
$cfmap :: forall a b. (a -> b) -> M a -> M b
Functor, Functor M
forall a. a -> M a
forall a b. M a -> M b -> M a
forall a b. M a -> M b -> M b
forall a b. M (a -> b) -> M a -> M b
forall a b c. (a -> b -> c) -> M a -> M b -> M c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. M a -> M b -> M a
$c<* :: forall a b. M a -> M b -> M a
*> :: forall a b. M a -> M b -> M b
$c*> :: forall a b. M a -> M b -> M b
liftA2 :: forall a b c. (a -> b -> c) -> M a -> M b -> M c
$cliftA2 :: forall a b c. (a -> b -> c) -> M a -> M b -> M c
<*> :: forall a b. M (a -> b) -> M a -> M b
$c<*> :: forall a b. M (a -> b) -> M a -> M b
pure :: forall a. a -> M a
$cpure :: forall a. a -> M a
Applicative, Monad M
forall a. IO a -> M a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> M a
$cliftIO :: forall a. IO a -> M a
MonadIO, MonadReader EwmhConf, MonadState EwmhState)
execM :: M a -> IO a
execM :: forall a. M a -> IO a
execM (M ReaderT EwmhConf (StateT EwmhState IO) a
m) = do
Display
d <- String -> IO Display
openDisplay String
""
Window
r <- Display -> Window -> IO Window
rootWindow Display
d (Display -> Window
defaultScreen Display
d)
let conf :: EwmhConf
conf = Window -> Display -> EwmhConf
C Window
r Display
d
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT EwmhConf (StateT EwmhState IO) a
m (Window -> Display -> EwmhConf
C Window
r Display
d)) EwmhState
initialState
type Updater = Window -> M ()
updateCurrentDesktop, updateDesktopNames, updateActiveWindow :: Updater
updateCurrentDesktop :: Updater
updateCurrentDesktop Window
_ = do
C {Window
root :: Window
root :: EwmhConf -> Window
root} <- forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe [CLong]
mwp <- String -> Window -> M (Maybe [CLong])
windowProperty32 String
"_NET_CURRENT_DESKTOP" Window
root
case Maybe [CLong]
mwp of
Just [CLong
x] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EwmhState
s -> EwmhState
s { currentDesktop :: CLong
currentDesktop = CLong
x })
Maybe [CLong]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateActiveWindow :: Updater
updateActiveWindow Window
_ = do
C {Window
root :: Window
root :: EwmhConf -> Window
root} <- forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe [CLong]
mwp <- String -> Window -> M (Maybe [CLong])
windowProperty32 String
"_NET_ACTIVE_WINDOW" Window
root
case Maybe [CLong]
mwp of
Just [CLong
x] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EwmhState
s -> EwmhState
s { activeWindow :: Window
activeWindow = forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
x })
Maybe [CLong]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateDesktopNames :: Updater
updateDesktopNames Window
_ = do
C {Window
root :: Window
root :: EwmhConf -> Window
root} <- forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe [CChar]
mwp <- String -> Window -> M (Maybe [CChar])
windowProperty8 String
"_NET_DESKTOP_NAMES" Window
root
case Maybe [CChar]
mwp of
Just [CChar]
xs -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EwmhState
s -> EwmhState
s { desktopNames :: [String]
desktopNames = [CChar] -> [String]
parse [CChar]
xs })
Maybe [CChar]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
dropNull :: ShowS
dropNull (Char
'\0':String
xs) = String
xs
dropNull String
xs = String
xs
split :: String -> [String]
split [] = []
split String
xs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'\0') String
xs of
(String
x, String
ys) -> String
x forall a. a -> [a] -> [a]
: String -> [String]
split (ShowS
dropNull String
ys)
parse :: [CChar] -> [String]
parse = String -> [String]
split forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CChar] -> String
decodeCChar
updateClientList :: p -> M ()
updateClientList p
_ = do
C {Window
root :: Window
root :: EwmhConf -> Window
root} <- forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe [CLong]
mwp <- String -> Window -> M (Maybe [CLong])
windowProperty32 String
"_NET_CLIENT_LIST" Window
root
case Maybe [CLong]
mwp of
Just [CLong]
xs -> do
Map Window Client
cl <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EwmhState -> Map Window Client
clients
let cl' :: Map Window Client
cl' = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((, Client
initialClient) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [CLong]
xs
dels :: Map Window Client
dels = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map Window Client
cl Map Window Client
cl'
new :: Map Window Client
new = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map Window Client
cl' Map Window Client
cl
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EwmhState
s -> EwmhState
s { clients :: Map Window Client
clients = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map Window Client
cl Map Window Client
cl') Map Window Client
cl'})
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {m :: * -> *}.
(MonadReader EwmhConf m, MonadIO m) =>
Window -> m ()
unmanage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a. Map k a -> [(k, a)]
Map.toList Map Window Client
dels)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {m :: * -> *}.
(MonadReader EwmhConf m, MonadIO m) =>
Window -> m ()
listen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a. Map k a -> [(k, a)]
Map.toList Map Window Client
cl')
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Updater
update forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a. Map k a -> [(k, a)]
Map.toList Map Window Client
new)
Maybe [CLong]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
unmanage :: Window -> m ()
unmanage Window
w = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Display
display forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
selectInput Display
d Window
w Window
0
listen :: Window -> m ()
listen Window
w = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Display
display forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
selectInput Display
d Window
w Window
propertyChangeMask
update :: Updater
update Window
w = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall a b. (a -> b) -> a -> b
$ Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(String, Updater)]
clientHandlers
modifyClient :: Window -> (Client -> Client) -> M ()
modifyClient :: Window -> (Client -> Client) -> M ()
modifyClient Window
w Client -> Client
f = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EwmhState
s -> EwmhState
s { clients :: Map Window Client
clients = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe Client -> Maybe Client
f' Window
w forall a b. (a -> b) -> a -> b
$ EwmhState -> Map Window Client
clients EwmhState
s })
where
f' :: Maybe Client -> Maybe Client
f' Maybe Client
Nothing = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Client -> Client
f Client
initialClient
f' (Just Client
x) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Client -> Client
f Client
x
updateName :: Updater
updateName Window
w = do
Maybe [CChar]
mwp <- String -> Window -> M (Maybe [CChar])
windowProperty8 String
"_NET_WM_NAME" Window
w
case Maybe [CChar]
mwp of
Just [CChar]
xs -> Window -> (Client -> Client) -> M ()
modifyClient Window
w (\Client
c -> Client
c { windowName :: String
windowName = [CChar] -> String
decodeCChar [CChar]
xs })
Maybe [CChar]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateDesktop :: Updater
updateDesktop Window
w = do
Maybe [CLong]
mwp <- String -> Window -> M (Maybe [CLong])
windowProperty32 String
"_NET_WM_DESKTOP" Window
w
case Maybe [CLong]
mwp of
Just [CLong]
x -> Window -> (Client -> Client) -> M ()
modifyClient Window
w (\Client
c -> Client
c { desktops :: Set CLong
desktops = forall a. Ord a => [a] -> Set a
Set.fromList [CLong]
x })
Maybe [CLong]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
decodeCChar :: [CChar] -> String
decodeCChar :: [CChar] -> String
decodeCChar = [Word8] -> String
UTF8.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral