Add initial DynamicPerScreenWorkspaces implementation

2 files changed, 148 insertions, 8 deletions

diff --git a/lib/DynamicPerScreenWorkspaces.hs b/lib/DynamicPerScreenWorkspaces.hs
new file mode 100644
index 0000000..8e52722
--- /dev/null
+++ b/lib/DynamicPerScreenWorkspaces.hs
@@ -0,0 +1,147 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module DynamicPerScreenWorkspaces ( WorkspaceScreens
+                                  , DynamicWorkspaceConfig(..)
+                                  , dynamicRescreenHook
+                                  , view
+                                  , viewOn
+                                  , viewOnCurrent
+                                  ) where
+
+import XMonad hiding (hide)
+import qualified XMonad.StackSet as W
+import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
+
+import Control.Arrow ((&&&))
+import Control.Monad
+import qualified Data.Map as M
+import Data.Maybe
+
+import Storage
+
+import System.IO
+
+
+data DynamicWorkspaceStoreData = DWSD (M.Map Int ScreenId)
+                                 deriving (Typeable, Show, Read)
+instance StoreData DynamicWorkspaceStoreData
+
+screenWorkspaceStorage :: (LayoutClass l a) => l a -> ModifiedLayout (Storage DynamicWorkspaceStoreData) l a
+screenWorkspaceStorage = storage (DWSD M.empty)
+
+
+type WorkspaceScreens = Int -> Int -> ScreenId
+
+data DynamicWorkspaceConfig = DynamicWorkspaceConfig
+                              { defaultWorkspaceScreen  :: !WorkspaceScreens
+                              , workspaceTag            :: !(Int -> WorkspaceId)
+                              }
+
+defaultScreenWorkspaces :: DynamicWorkspaceConfig -> Int -> ScreenId -> [Int]
+defaultScreenWorkspaces conf n s = filter ((== s) . defaultWorkspaceScreen conf n) [0..]
+
+
+dynamicRescreenHook :: DynamicWorkspaceConfig -> [ScreenDetail] -> X ()
+dynamicRescreenHook conf sds = do
+  layout <- asks $ layoutHook . config
+  windows $ cleanup . \wset -> let (as,bs) = splitAt (length sds) $ map W.workspace (W.current wset:W.visible wset)
+                         
+                                   mkWS i = let tag = workspaceTag conf i
+                                            in W.Workspace tag layout Nothing
+                         
+                                   mkScreen sid (Just ws) sd = W.Screen ws sid sd
+                                   mkScreen sid Nothing sd = W.Screen (mkWS $ nextEmpty' conf (length sds) sid wset) sid sd
+                                   
+                                   (s:ss) = zipWith3 mkScreen (map S [0..]) (map Just as ++ repeat Nothing) sds
+                               in wset {W.current = s, W.visible = ss, W.hidden = bs ++ W.hidden wset}
+
+workspaceScreen :: DynamicWorkspaceConfig -> Int -> X ScreenId
+workspaceScreen conf i = do
+  wset <- gets windowset
+  d <- getStoreData
+  let defaultScreen = defaultWorkspaceScreen conf (length $ W.screens wset) i
+  return $ case d of
+    Just (DWSD wsscreens) -> do
+       case (M.lookup i wsscreens) of
+         Just s  -> s
+         Nothing -> defaultScreen
+    _ ->
+      defaultScreen
+
+hide :: DynamicWorkspaceConfig -> Int -> WindowSet -> X WindowSet
+hide conf i wset = gets (W.screens . windowset) >>= foldM (flip hideOn) wset
+  where
+    hideOn s | (workspaceTag conf i) == (W.tag $ W.workspace s) = viewNextEmpty conf (W.screen s)
+    hideOn _ = return
+
+cleanup :: WindowSet -> WindowSet
+cleanup wset = wset { W.hidden = hidden' }
+  where
+    hidden' = filter (isJust . W.stack) $ W.hidden wset
+
+viewOn' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
+viewOn' conf sid i wset = do
+  io $ do
+    file <- openFile "/tmp/log" AppendMode
+    hPrint file "viewOn'"
+    hPrint file wset
+    hPrint file i
+    hClose file
+  
+  let tag = workspaceTag conf i
+  case W.tagMember tag wset of
+    False -> viewEmpty conf sid i wset
+    True -> do
+      wset' <- hide conf i wset
+      let mws = W.lookupWorkspace sid wset'
+      
+      io $ do
+        file <- openFile "/tmp/log" AppendMode
+        hPrint file "viewOn'+"
+        hPrint file wset
+        hPrint file mws
+        hPrint file tag
+        hClose file
+
+      return $ case mws of
+        Just ws -> W.view tag . W.view ws $ wset'
+        Nothing -> wset'
+
+viewEmpty :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
+viewEmpty conf sid i wset = do
+  layout <- asks $ layoutHook . config
+  
+  let tag = workspaceTag conf i
+      workspace = W.Workspace tag layout Nothing
+  
+  if W.tagMember tag wset then return wset else viewOn' conf sid i wset { W.hidden = workspace:(W.hidden wset) }
+
+nextEmpty' ::DynamicWorkspaceConfig -> Int -> ScreenId -> WindowSet -> Int
+nextEmpty' conf n sid wset = fst $ head $ dropWhile ((`W.tagMember` wset) . snd) $ map (id &&& workspaceTag conf) $ defaultScreenWorkspaces conf n sid
+
+nextEmpty ::  DynamicWorkspaceConfig -> ScreenId -> WindowSet -> Int
+nextEmpty conf sid wset = nextEmpty' conf (length $ W.screens wset) sid wset
+
+viewNextEmpty :: DynamicWorkspaceConfig -> ScreenId -> WindowSet -> X WindowSet
+viewNextEmpty conf sid wset = viewEmpty conf sid (nextEmpty conf sid wset) wset
+
+windows' :: (WindowSet -> X WindowSet) -> X ()
+windows' f = do
+  wset <- gets windowset
+  wset' <- f wset
+  windows . const . cleanup $ wset'
+
+view :: DynamicWorkspaceConfig -> Int -> X ()
+view conf i = do
+  sid <- workspaceScreen conf i
+  windows' $ viewOn' conf sid i
+
+viewOn :: DynamicWorkspaceConfig -> ScreenId -> Int -> X ()
+viewOn conf sid i = do
+  updateStoreData $ \(DWSD m) -> DWSD $ M.insert i sid m
+  windows' $ viewOn' conf sid i
+
+viewOnCurrent :: DynamicWorkspaceConfig -> Int -> X ()
+viewOnCurrent conf i = do
+  sid <- gets (W.screen . W.current . windowset)
+  viewOn conf sid i
diff --git a/lib/EwmhDesktops.hs b/lib/EwmhDesktops.hs
index 74d0260..334233d 100644
--- a/lib/EwmhDesktops.hs
+++ b/lib/EwmhDesktops.hs
@@ -85,14 +85,7 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
       Just curr -> do
         setCurrentDesktop curr
 
-        -- Per window Desktop
-        -- To make gnome-panel accept our xinerama stuff, we display
-        -- all visible windows on the current desktop.
-        forM_ (W.current s : W.visible s) $ \x ->
-            forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
-                setWindowDesktop win curr
-
-    forM_ (W.hidden s) $ \w ->
+    forM_ (map W.workspace (W.current s : W.visible s) ++ W.hidden s) $ \w ->
         case elemIndex (W.tag w) (map W.tag ws) of
           Nothing -> return ()
           Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do