module System.Information.EWMHDesktopInfo
( X11Window
, X11WindowHandle
, WorkspaceIdx(..)
, withDefaultCtx
, isWindowUrgent
, getCurrentWorkspace
, getVisibleWorkspaces
, getWorkspaceNames
, switchToWorkspace
, switchOneWorkspace
, getWindowTitle
, getWindowClass
, getActiveWindowTitle
, getWindows
, getWindowHandles
, getWorkspace
, focusWindow
) where
import Control.Applicative ((<$>))
import Data.Tuple (swap)
import Data.Maybe (listToMaybe, mapMaybe)
import System.Information.X11DesktopInfo
type X11WindowHandle = ((WorkspaceIdx, String, String), X11Window)
newtype WorkspaceIdx = WSIdx Int
deriving (Show, Read, Ord, Eq)
noFocus :: String
noFocus = "..."
getCurrentWorkspace :: X11Property WorkspaceIdx
getCurrentWorkspace = WSIdx <$> readAsInt Nothing "_NET_CURRENT_DESKTOP"
getVisibleWorkspaces :: X11Property [WorkspaceIdx]
getVisibleWorkspaces = do
vis <- getVisibleTags
allNames <- map swap <$> getWorkspaceNames
cur <- getCurrentWorkspace
return $ cur : mapMaybe (flip lookup allNames) vis
getWorkspaceNames :: X11Property [(WorkspaceIdx, String)]
getWorkspaceNames = go <$> readAsListOfString Nothing "_NET_DESKTOP_NAMES"
where go = zip [WSIdx i | i <- [0..]]
switchToWorkspace :: WorkspaceIdx -> X11Property ()
switchToWorkspace (WSIdx idx) = do
cmd <- getAtom "_NET_CURRENT_DESKTOP"
sendCommandEvent cmd (fromIntegral idx)
switchOneWorkspace :: Bool -> Int -> X11Property ()
switchOneWorkspace dir end = do
cur <- getCurrentWorkspace
switchToWorkspace $ if dir then getPrev cur end else getNext cur end
getPrev :: WorkspaceIdx -> Int -> WorkspaceIdx
getPrev (WSIdx idx) end
| idx > 0 = WSIdx $ idx1
| otherwise = WSIdx end
getNext :: WorkspaceIdx -> Int -> WorkspaceIdx
getNext (WSIdx idx) end
| idx < end = WSIdx $ idx+1
| otherwise = WSIdx 0
getWindowTitle :: X11Window -> X11Property String
getWindowTitle window = do
let w = Just window
prop <- readAsString w "_NET_WM_NAME"
case prop of
"" -> readAsString w "WM_NAME"
_ -> return prop
getWindowClass :: X11Window -> X11Property String
getWindowClass window = readAsString (Just window) "WM_CLASS"
withActiveWindow :: (X11Window -> X11Property String) -> X11Property String
withActiveWindow getProp = do
awt <- readAsListOfWindow Nothing "_NET_ACTIVE_WINDOW"
let w = listToMaybe $ filter (>0) awt
maybe (return noFocus) getProp w
getActiveWindowTitle :: X11Property String
getActiveWindowTitle = withActiveWindow getWindowTitle
getWindows :: X11Property [X11Window]
getWindows = readAsListOfWindow Nothing "_NET_CLIENT_LIST"
getWindowHandles :: X11Property [X11WindowHandle]
getWindowHandles = do
windows <- getWindows
workspaces <- mapM getWorkspace windows
wtitles <- mapM getWindowTitle windows
wclasses <- mapM getWindowClass windows
return $ zip (zip3 workspaces wtitles wclasses) windows
getWorkspace :: X11Window -> X11Property WorkspaceIdx
getWorkspace window = WSIdx <$> readAsInt (Just window) "_NET_WM_DESKTOP"
focusWindow :: X11Window -> X11Property ()
focusWindow wh = do
cmd <- getAtom "_NET_ACTIVE_WINDOW"
sendWindowEvent cmd (fromIntegral wh)