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