1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
module Graphics.X11.EWMH
( module Graphics.X11.EWMH
, module Graphics.X11.EWMH.Atom
) where
import Codec.Binary.UTF8.String (encode)
import Control.Applicative ((<|>))
import Data.List.Extra (split)
import Foreign.C.Types (CLong)
import Graphics.X11.EWMH.Atom
import Graphics.X11.Types (Window, clientMessage, substructureNotifyMask)
import Graphics.X11.Xlib.Atom.Extra
import Graphics.X11.Xlib.Event (allocaXEvent, sendEvent)
import Graphics.X11.Xlib.Display (defaultRootWindow)
import Graphics.X11.Xlib.Extras (changeProperty8, getWindowProperty32, propModeReplace, setClientMessageEvent', setEventType)
import Graphics.X11.Xlib.Extras.Extra (getWindowPropertyString)
import Graphics.X11.Xlib.Types (Display)
getActiveWindow :: Display -> IO (Maybe Window)
getActiveWindow dpy =
(fmap (fromIntegral . head) <$>) $
getWindowProperty32 dpy _NET_ACTIVE_WINDOW w
where w = defaultRootWindow dpy
getCurrentDesktop :: Display -> IO (Maybe CLong)
getCurrentDesktop dpy =
(fmap head <$>) $
getWindowProperty32 dpy _NET_CURRENT_DESKTOP w <|>
getWindowProperty32 dpy _WIN_WORKSPACE w
where w = defaultRootWindow dpy
getDesktopNames :: Display -> IO (Maybe [String])
getDesktopNames dpy = do
(fmap (init . split (=='\NUL')) <$>) $
getWindowPropertyString dpy _NET_DESKTOP_NAMES w <|>
getWindowPropertyString dpy _WIN_WORKSPACE_NAMES w
where w = defaultRootWindow dpy
getWindowDesktop :: Display -> Window -> IO (Maybe CLong)
getWindowDesktop dpy w =
(fmap head <$>) $
getWindowProperty32 dpy _NET_WM_DESKTOP w <|>
getWindowProperty32 dpy _WIN_WORKSPACE w
getWindowTitle :: Display -> Window -> IO (Maybe String)
getWindowTitle dpy w =
getWindowPropertyString dpy _NET_WM_NAME w <|>
getWindowPropertyString dpy _WM_NAME w
moveWindowToDesktop :: Display -> Window -> CLong -> IO ()
moveWindowToDesktop dpy w s =
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent' e (fromIntegral w) _NET_WM_DESKTOP 32 [fromIntegral s,0,0,0,0]
sendEvent dpy (fromIntegral w) True mask e
where
mask = substructureNotifyMask
setDesktopNames :: [String] -> Display -> IO ()
setDesktopNames names dpy = do
changeProperty8 dpy r a t propModeReplace names'
where
names' = map fromIntegral $ concatMap ((<>[0]) . encode) names
a = _NET_DESKTOP_NAMES
t = uTF8_STRING
r = defaultRootWindow dpy
switchToDesktop :: Display -> CLong -> IO ()
switchToDesktop dpy s =
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent' e w _NET_CURRENT_DESKTOP 32 [fromIntegral s,0,0,0,0]
sendEvent dpy w False mask e
where
w = defaultRootWindow dpy
mask = substructureNotifyMask
|
