From ee3027dcdf3348c0e9eb5f840617b028bfe49b82 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Fri, 25 Feb 2011 22:09:00 +0100
Subject: Allow ignoring process id when managing windows

---
 lib/ProcessWorkspaces.hs | 39 ++++++++++++++++++++++++++++-----------
 1 file changed, 28 insertions(+), 11 deletions(-)

(limited to 'lib')

diff --git a/lib/ProcessWorkspaces.hs b/lib/ProcessWorkspaces.hs
index 0cb65ab..74bf6c0 100644
--- a/lib/ProcessWorkspaces.hs
+++ b/lib/ProcessWorkspaces.hs
@@ -2,7 +2,8 @@
 
 module ProcessWorkspaces ( setProcessWorkspace
                          , getProcessWorkspace
-                         , moveWindowHook
+                         , doAutoShift
+                         , doIgnoreProcessWorkspace
                          , processWorkspaceStorage
                          , spawnOn
                          , spawnOnCurrent
@@ -26,8 +27,8 @@ import qualified Data.Map as M
 import Storage
 
 
-moveWindowHook :: ManageHook
-moveWindowHook = do
+doAutoShift :: ManageHook
+doAutoShift = do
   mp <- pid
   case mp of
     Just p -> do
@@ -35,36 +36,52 @@ moveWindowHook = do
       case mws of
         Just ws ->
           doShift ws
-        _ ->
+        _ -> do
           idHook
     _ ->
       idHook
 
+doIgnoreProcessWorkspace :: ManageHook
+doIgnoreProcessWorkspace = do
+  mp <- pid
+  when (isJust mp) $
+    liftX $ setProcessWorkspace (fromJust mp) Nothing
+  idHook
 
-data ProcessWorkspaceStoreData = ProcessWorkspaceStoreData (M.Map ProcessID WorkspaceId)
+data ProcessWorkspaceStoreData = ProcessWorkspaceStoreData (M.Map ProcessID (Maybe WorkspaceId))
                                  deriving (Typeable, Show, Read)
 instance StoreData ProcessWorkspaceStoreData
 
 processWorkspaceStorage :: (LayoutClass l a) => l a -> ModifiedLayout (Storage ProcessWorkspaceStoreData) l a
 processWorkspaceStorage = storage $ ProcessWorkspaceStoreData M.empty
 
-setProcessWorkspace :: ProcessID -> WorkspaceId -> X ()
+setProcessWorkspace :: ProcessID -> Maybe WorkspaceId -> X ()
 setProcessWorkspace pid ws = do
   ProcessWorkspaceStoreData map <- liftM (fromMaybe $ ProcessWorkspaceStoreData M.empty) $ getStoreData
   map' <- filterPIDMap $ M.insert pid ws map
   setStoreData $ ProcessWorkspaceStoreData map'
 
 getProcessWorkspace :: ProcessID -> X (Maybe WorkspaceId)
-getProcessWorkspace pid = getStoreData >>= return . join . fmap (\(ProcessWorkspaceStoreData map) -> M.lookup pid map)
-
-
-spawnOn :: WorkspaceId -> String -> X ()
+getProcessWorkspace pid = do
+  ws <- getStoreData >>= return . join . fmap (\(ProcessWorkspaceStoreData map) -> M.lookup pid $ map)
+  case ws of
+    Nothing -> do
+      wsc <- gets (W.currentTag . windowset)
+      setProcessWorkspace pid (Just wsc)
+      return $ Just wsc
+    Just Nothing ->
+      return Nothing
+    Just (Just ws') ->
+      return $ Just ws'
+
+
+spawnOn :: Maybe WorkspaceId -> String -> X ()
 spawnOn ws x = do
   pid <- spawnPID x
   setProcessWorkspace pid ws
 
 spawnOnCurrent :: String -> X ()
-spawnOnCurrent x = gets (W.currentTag . windowset) >>= \ws -> spawnOn ws x
+spawnOnCurrent x = gets (W.currentTag . windowset) >>= \ws -> spawnOn (Just ws) x
 
 
 filterPIDMap :: M.Map ProcessID a -> X (M.Map ProcessID a)
-- 
cgit v1.2.3