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
|
module ProcessWorkspaces ( setProcessWorkspace
|
||||||
, getProcessWorkspace
|
, getProcessWorkspace
|
||||||
, moveWindowHook
|
, doAutoShift
|
||||||
|
, doIgnoreProcessWorkspace
|
||||||
, processWorkspaceStorage
|
, processWorkspaceStorage
|
||||||
, spawnOn
|
, spawnOn
|
||||||
, spawnOnCurrent
|
, spawnOnCurrent
|
||||||
|
@ -26,8 +27,8 @@ import qualified Data.Map as M
|
||||||
import Storage
|
import Storage
|
||||||
|
|
||||||
|
|
||||||
moveWindowHook :: ManageHook
|
doAutoShift :: ManageHook
|
||||||
moveWindowHook = do
|
doAutoShift = do
|
||||||
mp <- pid
|
mp <- pid
|
||||||
case mp of
|
case mp of
|
||||||
Just p -> do
|
Just p -> do
|
||||||
|
@ -35,36 +36,52 @@ moveWindowHook = do
|
||||||
case mws of
|
case mws of
|
||||||
Just ws ->
|
Just ws ->
|
||||||
doShift ws
|
doShift ws
|
||||||
_ ->
|
_ -> do
|
||||||
idHook
|
idHook
|
||||||
_ ->
|
_ ->
|
||||||
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)
|
deriving (Typeable, Show, Read)
|
||||||
instance StoreData ProcessWorkspaceStoreData
|
instance StoreData ProcessWorkspaceStoreData
|
||||||
|
|
||||||
processWorkspaceStorage :: (LayoutClass l a) => l a -> ModifiedLayout (Storage ProcessWorkspaceStoreData) l a
|
processWorkspaceStorage :: (LayoutClass l a) => l a -> ModifiedLayout (Storage ProcessWorkspaceStoreData) l a
|
||||||
processWorkspaceStorage = storage $ ProcessWorkspaceStoreData M.empty
|
processWorkspaceStorage = storage $ ProcessWorkspaceStoreData M.empty
|
||||||
|
|
||||||
setProcessWorkspace :: ProcessID -> WorkspaceId -> X ()
|
setProcessWorkspace :: ProcessID -> Maybe WorkspaceId -> X ()
|
||||||
setProcessWorkspace pid ws = do
|
setProcessWorkspace pid ws = do
|
||||||
ProcessWorkspaceStoreData map <- liftM (fromMaybe $ ProcessWorkspaceStoreData M.empty) $ getStoreData
|
ProcessWorkspaceStoreData map <- liftM (fromMaybe $ ProcessWorkspaceStoreData M.empty) $ getStoreData
|
||||||
map' <- filterPIDMap $ M.insert pid ws map
|
map' <- filterPIDMap $ M.insert pid ws map
|
||||||
setStoreData $ ProcessWorkspaceStoreData map'
|
setStoreData $ ProcessWorkspaceStoreData map'
|
||||||
|
|
||||||
getProcessWorkspace :: ProcessID -> X (Maybe WorkspaceId)
|
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
|
spawnOn ws x = do
|
||||||
pid <- spawnPID x
|
pid <- spawnPID x
|
||||||
setProcessWorkspace pid ws
|
setProcessWorkspace pid ws
|
||||||
|
|
||||||
spawnOnCurrent :: String -> X ()
|
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)
|
filterPIDMap :: M.Map ProcessID a -> X (M.Map ProcessID a)
|
||||||
|
|
|
@ -80,7 +80,7 @@ myManageHook :: ManageHook
|
||||||
myManageHook = composeAll
|
myManageHook = composeAll
|
||||||
[ composeOne
|
[ composeOne
|
||||||
[ isDialog -?> doFloat
|
[ isDialog -?> doFloat
|
||||||
, className =? "Guake.py" -?> doFloatMaybeFullscreen -- <+> doConfigBorderOff)
|
, className =? "Guake.py" -?> (doFloatMaybeFullscreen <+> doIgnoreProcessWorkspace) -- <+> doConfigBorderOff)
|
||||||
--, className =? "Do" -?> (doFloat <+> doConfigBorderOff)
|
--, className =? "Do" -?> (doFloat <+> doConfigBorderOff)
|
||||||
, className =? "MPlayer" -?> doCenterFloat
|
, className =? "MPlayer" -?> doCenterFloat
|
||||||
, className =? "Gimp" -?> doFloat
|
, className =? "Gimp" -?> doFloat
|
||||||
|
@ -90,7 +90,7 @@ myManageHook = composeAll
|
||||||
, stringProperty "WM_ICON_NAME" =? "ZeroGS" -?> doFloat
|
, stringProperty "WM_ICON_NAME" =? "ZeroGS" -?> doFloat
|
||||||
, isFullscreen -?> doFullscreen
|
, isFullscreen -?> doFullscreen
|
||||||
]
|
]
|
||||||
, moveWindowHook
|
, doAutoShift
|
||||||
, manageHook gnomeConfig
|
, manageHook gnomeConfig
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
Reference in a new issue