xmonad-masser/src/XMonad/TopicUtils.hs

98 lines
3.4 KiB
Haskell
Raw Normal View History

2019-03-21 22:26:47 +02:00
{-# LANGUAGE TupleSections #-}
2019-03-19 10:10:18 +02:00
module XMonad.TopicUtils where
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
2019-03-21 22:26:47 +02:00
import Data.List (isPrefixOf, nub, sortOn)
2019-03-19 10:10:18 +02:00
import XMonad.Actions.TopicSpace
import XMonad
import qualified Data.Map as M
import XMonad.Actions.GridSelect hiding (gridselectWorkspace)
import XMonad.Util.Run (safeSpawn)
import qualified XMonad.StackSet as W
import XMonad.Util.Dmenu (dmenu)
import XMonad.Actions.DynamicWorkspaces
import XMonad.Util.NamedWindows (getName)
2019-03-21 22:26:47 +02:00
import Data.Ord
2019-03-19 10:10:18 +02:00
realTopicDir :: M.Map String FilePath -> X String
realTopicDir tg = do
topic <- realTopic
return . fromMaybe "" . M.lookup topic $ tg
safeRunInTerm :: Dir -> Maybe String -> X ()
safeRunInTerm dir Nothing = safeSpawn "urxvt" ["-cd", dir]
safeRunInTerm dir (Just command) = safeSpawn "urxvt" ["-cd", dir, "-e", command]
inactiveTags :: X [WorkspaceId]
2019-05-23 12:00:02 +03:00
inactiveTags = inactive' <$> gets windowset
2019-03-19 10:10:18 +02:00
where
2019-05-23 11:53:37 +03:00
inactive' s =
let current = W.currentTag s
2019-05-23 12:00:02 +03:00
in filter (current /=) . map W.tag $ W.hidden s <> map W.workspace (W.visible s)
2019-03-19 10:10:18 +02:00
gridselectMove :: GSConfig WorkspaceId -> X ()
gridselectMove conf = do
topics <- inactiveTags
gridselect conf [(x,x) | x <- topics] >>= maybe (return ()) (windows . W.shift)
dmenuMove :: X ()
dmenuMove = do
topics <- inactiveTags
dmenu topics >>= \t -> windows (W.shift t)
gsConfig :: GSConfig Window
gsConfig = def{gs_navigate = navNSearch, gs_colorizer = fromClassName}
-- Copied from gridselect and modified so that it doesn't contain current and visible
-- - Doesn't contain current and visible
-- - Takes a topicspace viewfunc
gridselectWorkspace :: GSConfig WorkspaceId -> (WorkspaceId -> X ()) -> X ()
gridselectWorkspace conf viewFunc = withWindowSet $ \ws -> do
2019-05-23 12:00:02 +03:00
let wss = filter (/= current) . map W.tag $ invisible <> visible
visible = fmap W.workspace (W.visible ws)
invisible = W.hidden ws
current = W.currentTag ws
2019-03-19 10:10:18 +02:00
gridselect conf (zip wss wss) >>= flip whenJust viewFunc
gotoSelected' :: GSConfig Window -> X ()
gotoSelected' gsconf = do
w <- gridselectCurrentWindows gsconf
maybe (return ()) (windows . W.focusWindow) w
gridselectCurrentWindows :: GSConfig Window -> X (Maybe Window)
gridselectCurrentWindows gsconf = windowMap >>= gridselect gsconf
where
getName' = fmap show . getName
2019-03-21 22:26:47 +02:00
kvPair w = (, w) <$> getName' w
2019-03-19 10:10:18 +02:00
windowMap = do
ws <- gets (nub . W.integrate' . W.stack . W.workspace . W.current . windowset)
mapM kvPair ws
visualSelect :: TopicConfig -> X ()
visualSelect cfg = gridselectWorkspace def{gs_navigate = navNSearch, gs_colorizer = stringColorizer} (switchTopic cfg)
realTopic :: X String
realTopic = gets (real . W.tag . W.workspace . W.current . windowset)
where real = takeWhile (/= ':')
currentTopicAction' :: TopicConfig -> X ()
currentTopicAction' tg = do
topic <- realTopic
topicAction tg topic
copyTopic :: X ()
copyTopic = do
currentTopic <- realTopic
2019-03-21 22:26:47 +02:00
lastN <- gets (listToMaybe . sortOn Down . mapMaybe (subset currentTopic . W.tag) . W.workspaces . windowset)
addWorkspace (currentTopic ++ ":" ++ show (maybe 2 (+1) lastN))
2019-03-19 10:10:18 +02:00
where
subset :: String -> String -> Maybe Int
2019-03-21 22:26:47 +02:00
subset topic other = if topic `isPrefixOf` other then readM $ tail' $ dropWhile (/= ':') other else Nothing
2019-03-19 10:10:18 +02:00
readM a = case reads a of
[(x,_)] -> Just x
_ -> Nothing
tail' [] = []
tail' xs = tail xs