From daadcaa31bf5bff6111a1d0cf7fee161b985cdab Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sat, 3 Sep 2011 13:00:38 +0200 Subject: DynamicPerScreenWorkspaces mostly working --- lib/DynamicPerScreenWorkspaces.hs | 65 ++++++++++++++++++--------------------- 1 file changed, 30 insertions(+), 35 deletions(-) (limited to 'lib') diff --git a/lib/DynamicPerScreenWorkspaces.hs b/lib/DynamicPerScreenWorkspaces.hs index 8e52722..c54e9a1 100644 --- a/lib/DynamicPerScreenWorkspaces.hs +++ b/lib/DynamicPerScreenWorkspaces.hs @@ -3,6 +3,8 @@ module DynamicPerScreenWorkspaces ( WorkspaceScreens , DynamicWorkspaceConfig(..) , dynamicRescreenHook + , create + , cleanup , view , viewOn , viewOnCurrent @@ -19,8 +21,6 @@ import Data.Maybe import Storage -import System.IO - data DynamicWorkspaceStoreData = DWSD (M.Map Int ScreenId) deriving (Typeable, Show, Read) @@ -44,16 +44,16 @@ defaultScreenWorkspaces conf n s = filter ((== s) . defaultWorkspaceScreen conf dynamicRescreenHook :: DynamicWorkspaceConfig -> [ScreenDetail] -> X () dynamicRescreenHook conf sds = do layout <- asks $ layoutHook . config - 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 - in W.Workspace tag layout Nothing + windows $ cleanup' . \wset -> let (as,bs) = splitAt (length sds) $ map W.workspace (W.current wset:W.visible wset) - 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 - - (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} + mkWS i = let tag = workspaceTag conf i + in W.Workspace tag layout Nothing + + 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 + + (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} workspaceScreen :: DynamicWorkspaceConfig -> Int -> X ScreenId 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 _ = return -cleanup :: WindowSet -> WindowSet -cleanup wset = wset { W.hidden = hidden' } +cleanup' :: WindowSet -> WindowSet +cleanup' wset = wset { W.hidden = hidden' } where hidden' = filter (isJust . W.stack) $ W.hidden wset viewOn' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet 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 case W.tagMember tag wset of False -> viewEmpty conf sid i wset @@ -95,26 +88,20 @@ viewOn' conf sid i wset = do wset' <- hide conf i 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 Just ws -> W.view tag . W.view ws $ wset' Nothing -> wset' -viewEmpty :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet -viewEmpty conf sid i wset = do +create' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet +create' conf sid i wset = do layout <- asks $ layoutHook . config - let tag = workspaceTag conf i 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' 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 wset <- gets windowset 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 conf i = do sid <- workspaceScreen conf i - windows' $ viewOn' conf sid i + windows' $ liftM cleanup' . viewOn' conf sid i viewOn :: DynamicWorkspaceConfig -> ScreenId -> Int -> X () viewOn conf sid i = do 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 conf i = do -- cgit v1.2.3