From 970914f872ed1ce0cbd7a067f35e8f77cde0a50e Mon Sep 17 00:00:00 2001 From: "quentin.moser" Date: Mon, 18 Jan 2010 03:15:26 +0100 Subject: X.L.Groups: Always keep one group, even if empty. Ignore-this: 22d7f9b92484c3411ecba66b06f69821 darcs-hash:20100118021526-5ccef-dc7dd054a62918c6d097ced0dce4c0ea46b446d7.gz --- XMonad/Layout/Groups.hs | 83 +++++++++++++++++++++++++++---------------------- 1 file changed, 46 insertions(+), 37 deletions(-) (limited to 'XMonad/Layout/Groups.hs') diff --git a/XMonad/Layout/Groups.hs b/XMonad/Layout/Groups.hs index 75658d7..fad1154 100644 --- a/XMonad/Layout/Groups.hs +++ b/XMonad/Layout/Groups.hs @@ -60,7 +60,7 @@ import qualified XMonad.StackSet as W import XMonad.Util.Stack -import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes) +import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust) import Data.List ((\\)) import Control.Arrow ((>>>)) import Control.Applicative ((<$>)) @@ -99,7 +99,8 @@ import Control.Monad (forM) -- need to manage 'Window's. This is obvious, when you think -- about it. group :: l Window -> l2 (Group l Window) -> Groups l l2 Window -group l l2 = Groups l l2 emptyZ (U 0 0) +group l l2 = Groups l l2 startingGroups (U 1 0) + where startingGroups = fromJust $ singletonZ $ G (ID (U 0 0) l) emptyZ -- * Stuff with unique keys @@ -167,7 +168,7 @@ data Groups l l2 a = Groups { -- | The starting layout for new groups -- | The layout for placing each group on the screen , partitioner :: l2 (Group l a) -- | The window groups - , groups :: Zipper (Group l a) + , groups :: W.Stack (Group l a) -- | A seed for generating unique ids , seed :: Uniq } @@ -203,7 +204,10 @@ instance Message GroupsMessage modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a)) -> Groups l l2 a -> Groups l l2 a -modifyGroups f g = g { groups = f $ groups g } +modifyGroups f g = let (seed', id:_) = gen (seed g) + defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ + in g { groups = fromMaybe defaultGroups . f . Just $ groups g + , seed = seed' } -- ** Readaptation @@ -213,21 +217,23 @@ modifyGroups f g = g { groups = f $ groups g } -- ignores changes in window ordering, and tries to react to any -- other stack changes as gracefully as possible. readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a -readapt Nothing g = g { groups = Nothing } -readapt (Just s) g = let f = W.focus s - (seed', id:_) = gen $ seed g - g' = g { seed = seed' } - in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted s) - >>> filterZ_ (isJust . gZipper) - >>> findNewWindows (W.integrate s) - >>> addWindows (ID id $ baseLayout g) - >>> focusGroup f - >>> onFocusedZ (onZipper $ focusWindow f) +readapt z g = let mf = getFocusZ z + (seed', id:_) = gen $ seed g + g' = g { seed = seed' } + in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z) + >>> filterKeepLast (isJust . gZipper) + >>> findNewWindows (W.integrate' z) + >>> addWindows (ID id $ baseLayout g) + >>> focusGroup mf + >>> onFocusedZ (onZipper $ focusWindow mf) + where filterKeepLast _ Nothing = Nothing + filterKeepLast f z@(Just s) = maybe (singletonZ $ W.focus s) Just + $ filterZ_ f z -- | Remove the windows from a group which are no longer present in -- the stack. -removeDeleted :: Eq a => W.Stack a -> Zipper a -> Zipper a -removeDeleted s = filterZ_ (flip elemZ $ Just s) +removeDeleted :: Eq a => Zipper a -> Zipper a -> Zipper a +removeDeleted z = filterZ_ (flip elemZ z) -- | Identify the windows not already in a group. findNewWindows :: Eq a => [a] -> Zipper (Group l a) @@ -243,12 +249,14 @@ addWindows _ (z, as) = onFocusedZ (onZipper add) z where add z = foldl (flip insertUpZ) z as -- | Focus the group containing the given window -focusGroup :: Eq a => a -> Zipper (Group l a) -> Zipper (Group l a) -focusGroup a = fromTags . map (tagBy $ elemZ a . gZipper) . W.integrate' +focusGroup :: Eq a => Maybe a -> Zipper (Group l a) -> Zipper (Group l a) +focusGroup Nothing = id +focusGroup (Just a) = fromTags . map (tagBy $ elemZ a . gZipper) . W.integrate' -- | Focus the given window -focusWindow :: Eq a => a -> Zipper a -> Zipper a -focusWindow a = fromTags . map (tagBy (==a)) . W.integrate' +focusWindow :: Eq a => Maybe a -> Zipper a -> Zipper a +focusWindow Nothing = id +focusWindow (Just a) = fromTags . map (tagBy (==a)) . W.integrate' -- * Interface @@ -258,18 +266,18 @@ focusWindow a = fromTags . map (tagBy (==a)) . W.integrate' instance (LayoutClass l Window, LayoutClass l2 (Group l Window)) => LayoutClass (Groups l l2) Window where - description (Groups b p gs _) = s1++" by "++s2 - where s1 = fromMaybe (description b) $ fmap (description . gLayout) $ getFocusZ gs + description (Groups _ p gs _) = s1++" by "++s2 + where s1 = description $ gLayout $ W.focus gs s2 = description p runLayout ws@(W.Workspace _ _l z) r = let l = readapt z _l in do (areas, mpart') <- runLayout ws { W.layout = partitioner l - , W.stack = groups l } r + , W.stack = Just $ groups l } r results <- forM areas $ \(g, r') -> runLayout ws { W.layout = gLayout g , W.stack = gZipper g } r' - let hidden = map gLayout (W.integrate' $ groups l) \\ map (gLayout . fst) areas + let hidden = map gLayout (W.integrate $ groups l) \\ map (gLayout . fst) areas hidden' <- mapM (flip handleMessage $ SomeMessage Hide) hidden let placements = concatMap fst results @@ -283,7 +291,7 @@ instance (LayoutClass l Window, LayoutClass l2 (Group l Window)) handleMessage l@(Groups _ p gs _) sm | Just (ToAll sm') <- fromMessage sm = do mp' <- handleMessage p sm' - mg's <- mapZM_ (handle sm') gs + mg's <- mapZM_ (handle sm') $ Just gs return $ maybeMakeNew l mp' $ W.integrate' mg's where handle sm (G l _) = handleMessage l sm @@ -292,7 +300,7 @@ instance (LayoutClass l Window, LayoutClass l2 (Group l Window)) -- of doing this? in handleMessage l $ SomeMessage $ ToAll sm - handleMessage l@(Groups _ _ z@(Just _) _) sm = case fromMessage sm of + handleMessage l@(Groups _ _ z _) sm = case fromMessage sm of Just (ToFocused sm') -> do mg's <- W.integrate' <$> handleOnFocused sm' z return $ maybeMakeNew l Nothing mg's Just (ToGroup i sm') -> do mg's <- handleOnIndex i sm' z @@ -303,34 +311,32 @@ instance (LayoutClass l Window, LayoutClass l2 (Group l Window)) Just Refocus -> refocus l >> return (Just l) Just _ -> return Nothing Nothing -> handleMessage l $ SomeMessage (ToFocused sm) - where handleOnFocused sm z = mapZM step z + where handleOnFocused sm z = mapZM step $ Just z where step True (G l _) = handleMessage l sm step False _ = return Nothing - handleOnIndex i sm z = mapM step $ zip [0..] $ W.integrate' z + handleOnIndex i sm z = mapM step $ zip [0..] $ W.integrate z where step (j, (G l _)) | i == j = handleMessage l sm step _ = return Nothing - handleMessage _ _ = return Nothing - justMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)] -> Maybe (Groups l l2 a) justMakeNew g mpart' ml's = Just g { partitioner = fromMaybe (partitioner g) mpart' , groups = combine (groups g) ml's } where combine z ml's = let table = map (\(ID id a) -> (id, a)) $ catMaybes ml's - in flip mapZ_ z $ \(G (ID id l) ws) -> case lookup id table of + in flip mapS_ z $ \(G (ID id l) ws) -> case lookup id table of Nothing -> G (ID id l) ws Just l' -> G (ID id l') ws + mapS_ f = fromJust . mapZ_ f . Just maybeMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)] -> Maybe (Groups l l2 a) -maybeMakeNew _ Nothing [] = Nothing maybeMakeNew _ Nothing ml's | all isNothing ml's = Nothing maybeMakeNew g mpart' ml's = justMakeNew g mpart' ml's refocus :: Groups l l2 Window -> X () -refocus g = case getFocusZ (groups g) >>= (getFocusZ . gZipper) +refocus g = case getFocusZ $ gZipper $ W.focus $ groups g of Just w -> focus w Nothing -> return () @@ -356,11 +362,14 @@ type ModifySpec = forall l. WithID l Window -- | Apply a ModifySpec. applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window) applySpec f g = let (seed', id:ids) = gen $ seed g - gs' = f (ID id $ baseLayout g) (groups g) - gs'' = fromTags $ snd $ foldr reID ((ids, []), []) $ toTags gs' - in case groups g == gs' of + g' = flip modifyGroups g $ f (ID id $ baseLayout g) + >>> toTags + >>> foldr reID ((ids, []), []) + >>> snd + >>> fromTags + in case groups g == groups g' of True -> Nothing - False -> Just g { groups = gs'', seed = seed' } + False -> Just g' { seed = seed' } where reID eg ((id:ids, seen), egs) = let myID = getID $ gLayout $ fromE eg -- cgit v1.2.3