twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-01 12:41:52 -07:00
Code Issues Packages Projects Releases Wiki Activity

make DynamicWorkspace more thorough.

Browse Source 
Note: there's still a bug due to our failure to inform
the old layouts to clean up.
This commit is contained in:
David Roundy
2007-08-14 01:45:48 +00:00
parent 93ae00b665
commit c6167c3f2d
1 changed files with 28 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
DynamicWorkspaces.hs
View File

@@ -19,34 +19,49 @@ module XMonadContrib.DynamicWorkspaces (
addWorkspace, removeWorkspace addWorkspace, removeWorkspace
) where ) where
import XMonad ( X ) import Control.Monad.State ( get, gets, modify )
import XMonad ( X, XState(..), Layout, trace )
import Operations ( windows ) import Operations ( windows )
import StackSet ( tagMember, StackSet(..), Screen(..), Workspace(..) ) import StackSet ( tagMember, StackSet(..), Screen(..), Workspace(..),
integrate, differentiate )
import Data.Map ( delete, insert )
import Graphics.X11.Xlib ( Window )
-- $usage -- $usage
-- You can use this module with the following in your Config.hs file: -- You can use this module with the following in your Config.hs file:
-- --
-- > import XMonadContrib.DynamicWorkspaces -- > import XMonadContrib.DynamicWorkspaces
-- --
-- > , ((modMask .|. shiftMask, xK_Up), addWorkspace) -- > , ((modMask .|. shiftMask, xK_Up), addWorkspace defaultLayouts)
-- > , ((modMask .|. shiftMask, xK_Down), removeWorkspace) -- > , ((modMask .|. shiftMask, xK_Down), removeWorkspace)
addWorkspace :: X () addWorkspace :: [Layout Window] -> X ()
addWorkspace = windows addWorkspace' addWorkspace (l:ls) = do s <- gets windowset
let newtag:_ = filter (not . (`tagMember` s)) [0..]
modify $ \st -> st { layouts = insert newtag (l,ls) $ layouts st }
windows (addWorkspace' newtag)
addWorkspace [] = trace "bad layouts in XMonadContrib.DynamicWorkspaces.addWorkspace\n"
removeWorkspace :: X () removeWorkspace :: X ()
removeWorkspace = windows removeWorkspace' removeWorkspace = do XState { windowset = s, layouts = fls } <- get
let w = tag $ workspace $ current s
modify $ \st -> st { layouts = delete w fls }
windows removeWorkspace'
addWorkspace' :: (Enum i, Num i) => StackSet i a sid sd -> StackSet i a sid sd addWorkspace' :: i -> StackSet i a sid sd -> StackSet i a sid sd
addWorkspace' s@(StackSet { current = scr@(Screen { workspace = w }) addWorkspace' newtag s@(StackSet { current = scr@(Screen { workspace = w })
, hidden = ws }) , hidden = ws })
= s { current = scr { workspace = Workspace newtag Nothing } = s { current = scr { workspace = Workspace newtag Nothing }
, hidden = w:ws } , hidden = w:ws }
where (newtag:_) = filter (not . (`tagMember` s)) [0..]
removeWorkspace' :: StackSet i a sid sd -> StackSet i a sid sd removeWorkspace' :: StackSet i a sid sd -> StackSet i a sid sd
removeWorkspace' s@(StackSet { current = scr@(Screen { workspace = Workspace { stack = Nothing } }) removeWorkspace' s@(StackSet { current = scr@(Screen { workspace = Workspace { stack = st } })
, hidden = (w:ws) }) , hidden = (w:ws) })
= s { current = scr { workspace = w } = s { current = scr { workspace = w { stack = meld st (stack w) } }
, hidden = ws } , 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 removeWorkspace' s = s