From ee3027dcdf3348c0e9eb5f840617b028bfe49b82 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer 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