Allow ignoring process id when managing windows
This commit is contained in:
parent
7cecc3bf51
commit
ee3027dcdf
2 changed files with 28 additions and 11 deletions
|
@ -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)
|
||||
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 :: WorkspaceId -> String -> X ()
|
||||
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)
|
||||
|
|
|
@ -80,7 +80,7 @@ myManageHook :: ManageHook
|
|||
myManageHook = composeAll
|
||||
[ composeOne
|
||||
[ isDialog -?> doFloat
|
||||
, className =? "Guake.py" -?> doFloatMaybeFullscreen -- <+> doConfigBorderOff)
|
||||
, className =? "Guake.py" -?> (doFloatMaybeFullscreen <+> doIgnoreProcessWorkspace) -- <+> doConfigBorderOff)
|
||||
--, className =? "Do" -?> (doFloat <+> doConfigBorderOff)
|
||||
, className =? "MPlayer" -?> doCenterFloat
|
||||
, className =? "Gimp" -?> doFloat
|
||||
|
@ -90,7 +90,7 @@ myManageHook = composeAll
|
|||
, stringProperty "WM_ICON_NAME" =? "ZeroGS" -?> doFloat
|
||||
, isFullscreen -?> doFullscreen
|
||||
]
|
||||
, moveWindowHook
|
||||
, doAutoShift
|
||||
, manageHook gnomeConfig
|
||||
]
|
||||
|
||||
|
|
Reference in a new issue