DynamicPerScreenWorkspaces mostly working

This commit is contained in:
Matthias Schiffer 2011-09-03 13:00:38 +02:00
parent d7735aa3cc
commit daadcaa31b
2 changed files with 35 additions and 43 deletions

View file

@ -3,6 +3,8 @@
module DynamicPerScreenWorkspaces ( WorkspaceScreens module DynamicPerScreenWorkspaces ( WorkspaceScreens
, DynamicWorkspaceConfig(..) , DynamicWorkspaceConfig(..)
, dynamicRescreenHook , dynamicRescreenHook
, create
, cleanup
, view , view
, viewOn , viewOn
, viewOnCurrent , viewOnCurrent
@ -19,8 +21,6 @@ import Data.Maybe
import Storage import Storage
import System.IO
data DynamicWorkspaceStoreData = DWSD (M.Map Int ScreenId) data DynamicWorkspaceStoreData = DWSD (M.Map Int ScreenId)
deriving (Typeable, Show, Read) deriving (Typeable, Show, Read)
@ -44,16 +44,16 @@ defaultScreenWorkspaces conf n s = filter ((== s) . defaultWorkspaceScreen conf
dynamicRescreenHook :: DynamicWorkspaceConfig -> [ScreenDetail] -> X () dynamicRescreenHook :: DynamicWorkspaceConfig -> [ScreenDetail] -> X ()
dynamicRescreenHook conf sds = do dynamicRescreenHook conf sds = do
layout <- asks $ layoutHook . config layout <- asks $ layoutHook . config
windows $ cleanup . \wset -> let (as,bs) = splitAt (length sds) $ map W.workspace (W.current wset:W.visible wset) windows $ cleanup' . \wset -> let (as,bs) = splitAt (length sds) $ map W.workspace (W.current wset:W.visible wset)
mkWS i = let tag = workspaceTag conf i mkWS i = let tag = workspaceTag conf i
in W.Workspace tag layout Nothing in W.Workspace tag layout Nothing
mkScreen sid (Just ws) sd = W.Screen ws sid sd mkScreen sid (Just ws) sd = W.Screen ws sid sd
mkScreen sid Nothing sd = W.Screen (mkWS $ nextEmpty' conf (length sds) sid wset) sid sd mkScreen sid Nothing sd = W.Screen (mkWS $ nextEmpty' conf (length sds) sid wset) sid sd
(s:ss) = zipWith3 mkScreen (map S [0..]) (map Just as ++ repeat Nothing) sds (s:ss) = zipWith3 mkScreen (map S [0..]) (map Just as ++ repeat Nothing) sds
in wset {W.current = s, W.visible = ss, W.hidden = bs ++ W.hidden wset} in wset {W.current = s, W.visible = ss, W.hidden = bs ++ W.hidden wset}
workspaceScreen :: DynamicWorkspaceConfig -> Int -> X ScreenId workspaceScreen :: DynamicWorkspaceConfig -> Int -> X ScreenId
workspaceScreen conf i = do workspaceScreen conf i = do
@ -74,20 +74,13 @@ hide conf i wset = gets (W.screens . windowset) >>= foldM (flip hideOn) wset
hideOn s | (workspaceTag conf i) == (W.tag $ W.workspace s) = viewNextEmpty conf (W.screen s) hideOn s | (workspaceTag conf i) == (W.tag $ W.workspace s) = viewNextEmpty conf (W.screen s)
hideOn _ = return hideOn _ = return
cleanup :: WindowSet -> WindowSet cleanup' :: WindowSet -> WindowSet
cleanup wset = wset { W.hidden = hidden' } cleanup' wset = wset { W.hidden = hidden' }
where where
hidden' = filter (isJust . W.stack) $ W.hidden wset hidden' = filter (isJust . W.stack) $ W.hidden wset
viewOn' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet viewOn' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
viewOn' conf sid i wset = do viewOn' conf sid i wset = do
io $ do
file <- openFile "/tmp/log" AppendMode
hPrint file "viewOn'"
hPrint file wset
hPrint file i
hClose file
let tag = workspaceTag conf i let tag = workspaceTag conf i
case W.tagMember tag wset of case W.tagMember tag wset of
False -> viewEmpty conf sid i wset False -> viewEmpty conf sid i wset
@ -95,26 +88,20 @@ viewOn' conf sid i wset = do
wset' <- hide conf i wset wset' <- hide conf i wset
let mws = W.lookupWorkspace sid wset' let mws = W.lookupWorkspace sid wset'
io $ do
file <- openFile "/tmp/log" AppendMode
hPrint file "viewOn'+"
hPrint file wset
hPrint file mws
hPrint file tag
hClose file
return $ case mws of return $ case mws of
Just ws -> W.view tag . W.view ws $ wset' Just ws -> W.view tag . W.view ws $ wset'
Nothing -> wset' Nothing -> wset'
viewEmpty :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet create' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
viewEmpty conf sid i wset = do create' conf sid i wset = do
layout <- asks $ layoutHook . config layout <- asks $ layoutHook . config
let tag = workspaceTag conf i let tag = workspaceTag conf i
workspace = W.Workspace tag layout Nothing workspace = W.Workspace tag layout Nothing
if W.tagMember tag wset then return wset else viewOn' conf sid i wset { W.hidden = workspace:(W.hidden wset) } return $ if W.tagMember tag wset then wset else wset { W.hidden = workspace:(W.hidden wset) }
viewEmpty :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
viewEmpty conf sid i = create' conf sid i >=> viewOn' conf sid i
nextEmpty' ::DynamicWorkspaceConfig -> Int -> ScreenId -> WindowSet -> Int nextEmpty' ::DynamicWorkspaceConfig -> Int -> ScreenId -> WindowSet -> Int
nextEmpty' conf n sid wset = fst $ head $ dropWhile ((`W.tagMember` wset) . snd) $ map (id &&& workspaceTag conf) $ defaultScreenWorkspaces conf n sid nextEmpty' conf n sid wset = fst $ head $ dropWhile ((`W.tagMember` wset) . snd) $ map (id &&& workspaceTag conf) $ defaultScreenWorkspaces conf n sid
@ -129,17 +116,25 @@ windows' :: (WindowSet -> X WindowSet) -> X ()
windows' f = do windows' f = do
wset <- gets windowset wset <- gets windowset
wset' <- f wset wset' <- f wset
windows . const . cleanup $ wset' windows . const $ wset'
create :: DynamicWorkspaceConfig -> Int -> X ()
create conf i = do
sid <- workspaceScreen conf i
windows' $ create' conf sid i
cleanup :: X ()
cleanup = windows cleanup'
view :: DynamicWorkspaceConfig -> Int -> X () view :: DynamicWorkspaceConfig -> Int -> X ()
view conf i = do view conf i = do
sid <- workspaceScreen conf i sid <- workspaceScreen conf i
windows' $ viewOn' conf sid i windows' $ liftM cleanup' . viewOn' conf sid i
viewOn :: DynamicWorkspaceConfig -> ScreenId -> Int -> X () viewOn :: DynamicWorkspaceConfig -> ScreenId -> Int -> X ()
viewOn conf sid i = do viewOn conf sid i = do
updateStoreData $ \(DWSD m) -> DWSD $ M.insert i sid m updateStoreData $ \(DWSD m) -> DWSD $ M.insert i sid m
windows' $ viewOn' conf sid i windows' $ liftM cleanup' . viewOn' conf sid i
viewOnCurrent :: DynamicWorkspaceConfig -> Int -> X () viewOnCurrent :: DynamicWorkspaceConfig -> Int -> X ()
viewOnCurrent conf i = do viewOnCurrent conf i = do

View file

@ -60,11 +60,10 @@ main = xmonad $ ewmh $ defaultConfig
, ("<XF86AudioRaiseVolume>", spawn "amixer -q sset Master 5%+ unmute") , ("<XF86AudioRaiseVolume>", spawn "amixer -q sset Master 5%+ unmute")
, ("M1-<F4>", kill) , ("M1-<F4>", kill)
] ]
-- ++ [ (("M-C-" ++ show n, windows $ W.greedyView ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] ++ [ ("M-" ++ show n, view dwConfig ws) | (ws, n) <- zip [0..] ([1..9]++[0])]
++ [ (("M-S-" ++ show n, shiftGroup ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] ++ [ ("M-C-" ++ show n, viewOnCurrent dwConfig ws) | (ws, n) <- zip [0..] ([1..9]++[0])]
-- ++ [ (("M-C-" ++ show n, shiftIgnoreGroup ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] ++ [ ("M-S-" ++ show n, create dwConfig ws >> shiftGroup (workspaceTag dwConfig ws) >> cleanup) | (ws, n) <- zip [0..] ([1..9]++[0])]
++ [ (("M-" ++ show n, view dwConfig ws)) | (ws, n) <- zip [0..] ([1..9]++[0])] ++ [ ("M-S-C-" ++ show n, create dwConfig ws >> shiftIgnoreGroup (workspaceTag dwConfig ws) >> cleanup) | (ws, n) <- zip [0..] ([1..9]++[0])]
++ [ (("M-C-" ++ show n, viewOnCurrent dwConfig ws)) | (ws, n) <- zip [0..] ([1..9]++[0])]
) )
`additionalMouseBindings` `additionalMouseBindings`
[ ((modm, button4), \_ -> sendMessage Shrink) [ ((modm, button4), \_ -> sendMessage Shrink)
@ -74,8 +73,6 @@ main = xmonad $ ewmh $ defaultConfig
] ]
myWorkspaces = map show [1..10]
dwConfig :: DynamicWorkspaceConfig dwConfig :: DynamicWorkspaceConfig
dwConfig = DynamicWorkspaceConfig { defaultWorkspaceScreen = defWSScreen dwConfig = DynamicWorkspaceConfig { defaultWorkspaceScreen = defWSScreen
, workspaceTag = show . (+1) , workspaceTag = show . (+1)
@ -87,7 +84,7 @@ defWSScreen 1 _ = S 0
defWSScreen _ i | i `elem` [0..7] = S 0 defWSScreen _ i | i `elem` [0..7] = S 0
defWSScreen _ i | i `elem` [8,9] = S 1 defWSScreen _ i | i `elem` [8,9] = S 1
defWSScreen n i = S (i `mod` n) defWSScreen n i = S ((i-10) `mod` n)
viewOrWarp :: Int -> X () viewOrWarp :: Int -> X ()