module XMonad.Actions.DynamicWorkspaces (
addWorkspace, addWorkspacePrompt,
removeWorkspace,
removeEmptyWorkspace,
removeEmptyWorkspaceAfter,
removeEmptyWorkspaceAfterExcept,
addHiddenWorkspace,
withWorkspace,
selectWorkspace, renameWorkspace,
renameWorkspaceByName,
toNthWorkspace, withNthWorkspace
) where
import XMonad hiding (workspaces)
import XMonad.StackSet hiding (filter, modify, delete)
import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )
import XMonad.Prompt ( XPConfig, mkXPrompt )
import XMonad.Util.WorkspaceCompare ( getSortByIndex )
import Data.List (find)
import Data.Maybe (isNothing)
import Control.Monad (when)
mkCompl :: [String] -> String -> IO [String]
mkCompl l s = return $ filter (\x -> take (length s) x == s) l
withWorkspace :: XPConfig -> (String -> X ()) -> X ()
withWorkspace c job = do ws <- gets (workspaces . windowset)
sort <- getSortByIndex
let ts = map tag $ sort ws
job' t | t `elem` ts = job t
| otherwise = addHiddenWorkspace t >> job t
mkXPrompt (Wor "") c (mkCompl ts) job'
renameWorkspace :: XPConfig -> X ()
renameWorkspace conf = workspacePrompt conf renameWorkspaceByName
renameWorkspaceByName :: String -> X ()
renameWorkspaceByName w = windows $ \s -> let sett wk = wk { tag = w }
setscr scr = scr { workspace = sett $ workspace scr }
sets q = q { current = setscr $ current q }
in sets $ removeWorkspace' w s
toNthWorkspace :: (String -> X ()) -> Int -> X ()
toNthWorkspace job wnum = do sort <- getSortByIndex
ws <- gets (map tag . sort . workspaces . windowset)
case drop wnum ws of
(w:_) -> job w
[] -> return ()
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace job wnum = do sort <- getSortByIndex
ws <- gets (map tag . sort . workspaces . windowset)
case drop wnum ws of
(w:_) -> windows $ job w
[] -> return ()
selectWorkspace :: XPConfig -> X ()
selectWorkspace conf = workspacePrompt conf $ \w ->
do s <- gets windowset
if tagMember w s
then windows $ greedyView w
else addWorkspace w
addWorkspace :: String -> X ()
addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)
addWorkspacePrompt :: XPConfig -> X ()
addWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) addWorkspace
addHiddenWorkspace :: String -> X ()
addHiddenWorkspace newtag =
whenX (gets (not . tagMember newtag . windowset)) $ do
l <- asks (layoutHook . config)
windows (addHiddenWorkspace' newtag l)
removeEmptyWorkspace :: X ()
removeEmptyWorkspace = gets (currentTag . windowset) >>= removeEmptyWorkspaceByTag
removeWorkspace :: X ()
removeWorkspace = gets (currentTag . windowset) >>= removeWorkspaceByTag
removeEmptyWorkspaceByTag :: String -> X ()
removeEmptyWorkspaceByTag t = whenX (isEmpty t) $ removeWorkspaceByTag t
removeWorkspaceByTag :: String -> X ()
removeWorkspaceByTag torem = do
s <- gets windowset
case s of
StackSet { current = Screen { workspace = cur }, hidden = (w:_) } -> do
when (torem==tag cur) $ windows $ view $ tag w
windows $ removeWorkspace' torem
_ -> return ()
removeEmptyWorkspaceAfter :: X () -> X ()
removeEmptyWorkspaceAfter = removeEmptyWorkspaceAfterExcept []
removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X ()
removeEmptyWorkspaceAfterExcept sticky f = do
before <- gets (currentTag . windowset)
f
after <- gets (currentTag . windowset)
when (before/=after && before `notElem` sticky) $ removeEmptyWorkspaceByTag before
isEmpty :: String -> X Bool
isEmpty t = do wsl <- gets $ workspaces . windowset
let mws = find (\ws -> tag ws == t) wsl
return $ maybe True (isNothing . stack) mws
addHiddenWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
addHiddenWorkspace' newtag l s@(StackSet { hidden = ws }) = s { hidden = Workspace newtag l Nothing:ws }
removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
, hidden = (w:ws) })
| tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } }
, hidden = ws }
where meld Nothing Nothing = Nothing
meld x Nothing = x
meld Nothing x = x
meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)
removeWorkspace' _ s = s