From 4711289c5e074bd5a1070726e8c3bbd84b26a5a6 Mon Sep 17 00:00:00 2001
From: David Roundy <droundy@darcs.net>
Date: Tue, 14 Aug 2007 03:45:48 +0200
Subject: make DynamicWorkspace more thorough.

Note: there's still a bug due to our failure to inform
the old layouts to clean up.

darcs-hash:20070814014548-72aca-9b66ee3deba31a15b6e0b0dd0b79847edc6fc6e3.gz
---
 DynamicWorkspaces.hs | 41 ++++++++++++++++++++++++++++-------------
 1 file changed, 28 insertions(+), 13 deletions(-)

(limited to 'DynamicWorkspaces.hs')

diff --git a/DynamicWorkspaces.hs b/DynamicWorkspaces.hs
index 0f417bb..51ee58f 100644
--- a/DynamicWorkspaces.hs
+++ b/DynamicWorkspaces.hs
@@ -19,34 +19,49 @@ module XMonadContrib.DynamicWorkspaces (
                                          addWorkspace, removeWorkspace
                                        ) where
 
-import XMonad ( X )
+import Control.Monad.State ( get, gets, modify )
+
+import XMonad ( X, XState(..), Layout, trace )
 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
 -- You can use this module with the following in your Config.hs file:
 -- 
 -- > import XMonadContrib.DynamicWorkspaces
 --
--- >   , ((modMask .|. shiftMask, xK_Up), addWorkspace)
+-- >   , ((modMask .|. shiftMask, xK_Up), addWorkspace defaultLayouts)
 -- >   , ((modMask .|. shiftMask, xK_Down), removeWorkspace)
 
-addWorkspace :: X ()
-addWorkspace = windows addWorkspace'
+addWorkspace :: [Layout Window] -> X ()
+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 = 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' s@(StackSet { current = scr@(Screen { workspace = w })
-                          , hidden = ws })
+addWorkspace' :: i -> StackSet i a sid sd -> StackSet i a sid sd
+addWorkspace' newtag s@(StackSet { current = scr@(Screen { workspace = w })
+                                 , hidden = ws })
     = s { current = scr { workspace = Workspace newtag Nothing }
         , hidden = w:ws }
-    where (newtag:_) = filter (not . (`tagMember` s)) [0..]
 
 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) })
-                    = s { current = scr { workspace = w }
-                        , hidden = ws }
+ = s { current = scr { workspace = w { stack = meld st (stack w) } }
+     , 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
-- 
cgit v1.2.3