From 016dc1e4b7e90c3e83f29a3575aa800f193cc8be Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Sun, 27 Feb 2011 16:18:48 +0100
Subject: Allow moving whole processes to other workspaces

---
 lib/ProcessWorkspaces.hs | 23 ++++++++++++++++++++++-
 lib/Storage.hs           |  7 +++----
 2 files changed, 25 insertions(+), 5 deletions(-)

(limited to 'lib')

diff --git a/lib/ProcessWorkspaces.hs b/lib/ProcessWorkspaces.hs
index 74bf6c0..0b14bff 100644
--- a/lib/ProcessWorkspaces.hs
+++ b/lib/ProcessWorkspaces.hs
@@ -4,6 +4,8 @@ module ProcessWorkspaces ( setProcessWorkspace
                          , getProcessWorkspace
                          , doAutoShift
                          , doIgnoreProcessWorkspace
+                         , shiftGroup
+                         , shiftWinGroup
                          , processWorkspaceStorage
                          , spawnOn
                          , spawnOnCurrent
@@ -21,7 +23,6 @@ import System.Posix.Types (ProcessID)
 
 import Control.Monad
 import Data.Maybe
-import Data.Monoid
 import qualified Data.Map as M
 
 import Storage
@@ -48,6 +49,26 @@ doIgnoreProcessWorkspace = do
     liftX $ setProcessWorkspace (fromJust mp) Nothing
   idHook
 
+shiftGroup :: WorkspaceId -> X ()
+shiftGroup ws = withFocused $ shiftWinGroup ws
+
+shiftWinGroup :: WorkspaceId -> Window -> X ()
+shiftWinGroup ws w = do
+  mp <- runQuery pid w
+  case mp of
+    Just p -> do
+      mws <- getProcessWorkspace p
+      case mws of
+        Just pws -> do
+          setProcessWorkspace p (Just ws)
+          wins <- withWindowSet $ return . W.allWindows
+          windows =<< foldM (\f w' -> runQuery pid w' >>= \mp' -> return $ if (mp' == Just p) then W.shiftWin ws w' . f else f) id wins
+        _ ->
+          windows $ W.shiftWin ws w
+    _ ->
+      windows $ W.shiftWin ws w
+
+
 data ProcessWorkspaceStoreData = ProcessWorkspaceStoreData (M.Map ProcessID (Maybe WorkspaceId))
                                  deriving (Typeable, Show, Read)
 instance StoreData ProcessWorkspaceStoreData
diff --git a/lib/Storage.hs b/lib/Storage.hs
index d8fae48..7f68b15 100644
--- a/lib/Storage.hs
+++ b/lib/Storage.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TypeSynonymInstances, MultiParamTypeClasses, ScopedTypeVariables, FlexibleInstances, PatternGuards #-}
+{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances, PatternGuards #-}
 
 module Storage ( StoreData
                , Storage
@@ -16,7 +16,6 @@ import Control.Applicative ((<$>))
 import Control.Monad
 
 import Data.IORef
-import qualified Data.Map as M
 import Data.Maybe
 import Data.Typeable
 
@@ -35,11 +34,11 @@ instance (StoreData d) => LayoutModifier (Storage d) a where
   modifierDescription _ = "Storage"
     
   handleMess (Storage d) m
-    | Just (GetStoreData ref :: StorageMessage d) <- fromMessage m = do
+    | Just (GetStoreData ref) <- fromMessage m = do
       io $ writeIORef ref $ Just d
       return $ Nothing
 
-    | Just (SetStoreData d' :: StorageMessage d) <- fromMessage m = do
+    | Just (SetStoreData d') <- fromMessage m = do
       return $ Just $ Storage d'
 
   handleMess _ _ = return Nothing
-- 
cgit v1.2.3