[XMonad] Add virtual classes for renaming

This commit is contained in:
Ivan Malison 2016-10-27 17:33:35 -07:00
parent ab74ddb90b
commit bf9238fd54
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8

View File

@ -1,5 +1,6 @@
{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}
import Control.Monad import Control.Monad
import Control.Monad.Trans.Maybe
import Data.Aeson import Data.Aeson
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
import Data.List import Data.List
@ -57,6 +58,8 @@ emacsSelector = className =? "Emacs"
hangoutsSelector = className =? "google-chrome" <&&> hangoutsSelector = className =? "google-chrome" <&&>
fmap isHangoutsTitle title fmap isHangoutsTitle title
virtualClasses = [(hangoutsSelector, "Hangouts")]
-- Startup -- Startup
myStartup = spawn "systemctl --user start wm.target" myStartup = spawn "systemctl --user start wm.target"
@ -82,9 +85,20 @@ myWindowBringerConfig = WindowBringerConfig { menuCommand = "rofi"
, windowTitler = myDecorateName , windowTitler = myDecorateName
} }
findM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findM f = runMaybeT . msum . map (MaybeT . f)
classIfMatches window entry = do
result <- runQuery (fst entry) window
return $ if result then Just $ snd entry else Nothing
getClass w = do getClass w = do
virtualClass <- findM (classIfMatches w) virtualClasses
case virtualClass of
Nothing -> do
classHint <- withDisplay $ \d -> io $ getClassHint d w classHint <- withDisplay $ \d -> io $ getClassHint d w
return $ resClass classHint return $ resClass classHint
Just name -> return name
myDecorateName ws w = do myDecorateName ws w = do
name <- show <$> getName w name <- show <$> getName w