module XMonad.ManageHook where
import Prelude hiding (catch)
import XMonad.Core
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME)
import Control.Exception (bracket, catch)
import Control.Monad.Reader
import Data.Maybe
import Data.Monoid
import qualified XMonad.StackSet as W
import XMonad.Operations (floatLocation, reveal)
liftX :: X a -> Query a
liftX = Query . lift
idHook :: ManageHook
idHook = doF id
(<+>) :: ManageHook -> ManageHook -> ManageHook
(<+>) = mappend
composeAll :: [ManageHook] -> ManageHook
composeAll = mconcat
(-->) :: Query Bool -> ManageHook -> ManageHook
p --> f = p >>= \b -> if b then f else mempty
(=?) :: Eq a => Query a -> a -> Query Bool
q =? x = fmap (== x) q
infixr 3 <&&>, <||>
(<&&>) :: Monad m => m Bool -> m Bool -> m Bool
(<&&>) = liftM2 (&&)
(<||>) :: Monad m => m Bool -> m Bool -> m Bool
(<||>) = liftM2 (||)
title :: Query String
title = ask >>= \w -> liftX $ do
d <- asks display
let
getProp =
(internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)
`catch` \_ -> getTextProperty d w wM_NAME
extract = fmap head . wcTextPropertyToTextList d
io $ bracket getProp (xFree . tp_value) extract `catch` \_ -> return ""
appName :: Query String
appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w)
resource :: Query String
resource = appName
className :: Query String
className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w)
stringProperty :: String -> Query String
stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ getStringProperty d w p)
getStringProperty :: Display -> Window -> String -> X (Maybe String)
getStringProperty d w p = do
a <- getAtom p
md <- io $ getWindowProperty8 d a w
return $ fmap (map (toEnum . fromIntegral)) md
doF :: (WindowSet -> WindowSet) -> ManageHook
doF = return . Endo
doFloat :: ManageHook
doFloat = ask >>= \w -> doF . W.float w . snd =<< liftX (floatLocation w)
doIgnore :: ManageHook
doIgnore = ask >>= \w -> liftX (reveal w) >> doF (W.delete w)
doShift :: WorkspaceId -> ManageHook
doShift = doF . W.shift