summaryrefslogtreecommitdiffstats
path: root/lib/Graphics/X11/EWMH.hs
blob: 856cfdb54330cd002102e02bba88d411fd1cc4d0 (plain)
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
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

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