[XMonad] Add virtual classes for renaming
This commit is contained in:
parent
ab74ddb90b
commit
bf9238fd54
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user