module Graphics.UI.BoringWindowSwitcher.Internal.Control
( Control, withControl,
Window, windowName, selectableWindows, raiseWindow
) where
import Control.Applicative ((<|>), (<$>))
import Control.Exception (bracket)
import Control.Monad (mapM, guard, filterM)
import Control.Monad.Trans.Maybe (MaybeT(..))
import Control.Monad.IO.Class (liftIO)
import Data.Maybe (listToMaybe)
import qualified Graphics.X11.Xlib as Xlib
import qualified Graphics.X11.Xlib.Extras as XlibE
newtype Control = Control { controlDisplay :: Xlib.Display }
withControl :: (Control -> IO a) -> IO a
withControl = bracket (Control <$> Xlib.openDisplay "") (Xlib.closeDisplay . controlDisplay)
data Window = Window { windowID :: !Xlib.Window,
windowName :: !String
} deriving (Show,Eq,Ord)
toOurWindow :: Xlib.Display -> Xlib.Window -> IO Window
toOurWindow disp wid = Window wid <$> xGetWindowName disp wid
withDefaultOf :: Functor m => a -> MaybeT m a -> m a
withDefaultOf def_value = (fmap $ maybe def_value id) . runMaybeT
xGetWindowName :: Xlib.Display -> Xlib.Window -> IO String
xGetWindowName disp win = withDefaultOf "" $ propAt "_NET_WM_NAME" <|> propAt "WM_NAME"
where
propAt prop_name_str = do
prop_name_atom <- liftIO $ Xlib.internAtom disp prop_name_str False
tprop <- liftIO $ XlibE.getTextProperty disp win prop_name_atom
guard (XlibE.tp_nitems tprop > 0)
MaybeT $ listToMaybe <$> XlibE.wcTextPropertyToTextList disp tprop
selectableWindows :: Control -> IO [Window]
selectableWindows cont = mapM (toOurWindow disp) =<< xSelectableWindows disp where
disp = controlDisplay cont
nothingToExcept :: String -> MaybeT IO a -> IO a
nothingToExcept error_message m = maybe (fail error_message) return =<< runMaybeT m
xSelectableWindows :: Xlib.Display -> IO [Xlib.Window]
xSelectableWindows disp = filterM (xIsWindowForPager disp) =<< allWindows
where
allWindows = nothingToExcept "Cannot obtain X client list."
$ winsFor "_NET_CLIENT_LIST_STACKING"
<|> winsFor "_NET_CLIENT_LIST"
<|> winsFor "_WIN_CLIENT_LIST"
winsFor request = do
req_atom <- liftIO $ Xlib.internAtom disp request False
raw_list <- (fmap . map) fromIntegral $ MaybeT $ XlibE.getWindowProperty32 disp req_atom (Xlib.defaultRootWindow disp)
return $ reverse raw_list
xIsWindowForPager :: Xlib.Display -> Xlib.Window -> IO Bool
xIsWindowForPager disp win = impl where
impl = do
state_req <- Xlib.internAtom disp "_NET_WM_STATE" False
mret <- XlibE.getWindowProperty32 disp state_req win
case mret of
Nothing -> return True
Just raw_atoms -> do
let state_atoms = map fromIntegral raw_atoms
skip_atom <- Xlib.internAtom disp "_NET_WM_STATE_SKIP_PAGER" False
return $ not $ skip_atom `elem` state_atoms
raiseWindow :: Control -> Window -> IO ()
raiseWindow cont win = do
Xlib.raiseWindow disp wid
where
disp = controlDisplay cont
wid = windowID win