Skip to content

Commit

Permalink
Merge branches 'sublayouts-floating-order', 'sublayouts-stack-of-stacks'
Browse files Browse the repository at this point in the history
  • Loading branch information
liskin committed May 11, 2021
2 parents da59f9f + 8cdbb5d commit a622c08
Show file tree
Hide file tree
Showing 2 changed files with 51 additions and 32 deletions.
4 changes: 4 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -547,6 +547,10 @@
- Added `defWPNamesJpg` as an alias to `defWPNames` and deprecated
the latter.

* `XMonad.Layout.SubLayouts`

- Floating windows are no longer moved to the end of the window stack.

## 0.16

### Breaking Changes
Expand Down
79 changes: 47 additions & 32 deletions XMonad/Layout/SubLayouts.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,16 +52,17 @@ import XMonad.Util.Invisible(Invisible(..))
import XMonad.Util.Types(Direction2D(..))
import XMonad hiding (def)
import Control.Arrow(Arrow(second, (&&&)))
import Control.Monad(MonadPlus(mplus), foldM, guard, when, join)
import Control.Monad((<=<), MonadPlus(mplus), foldM, guard, when, join)
import Data.Function(on)
import Data.List(nubBy, (\\), find)
import Data.List(nubBy)
import Data.Maybe(isNothing, fromMaybe, listToMaybe, mapMaybe)

import qualified XMonad as X
import qualified XMonad.Layout.BoringWindows as B
import qualified XMonad.StackSet as W
import qualified Data.Map as M
import Data.Map(Map)
import qualified Data.Set as S

-- $screenshots
--
Expand Down Expand Up @@ -238,6 +239,9 @@ data Sublayout l a = Sublayout
-- This representation probably simplifies the internals of the modifier.
type Groups a = Map a (W.Stack a)

-- | Stack of stacks, a simple representation of groups for purposes of focus.
type GroupStack a = W.Stack (W.Stack a)

-- | GroupMsg take window parameters to determine which group the action should
-- be applied to
data GroupMsg a
Expand Down Expand Up @@ -302,7 +306,7 @@ instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModif
let gs' = updateGroup st $ toGroups osls
st' = W.filter (`elem` M.keys gs') =<< st
updateWs gs'
oldStack <- gets $ W.stack . W.workspace . W.current . windowset
oldStack <- currentStack
setStack st'
runLayout (W.Workspace i la st') r <* setStack oldStack
-- FIXME: merge back reordering, deletions?
Expand Down Expand Up @@ -413,26 +417,8 @@ currentStack = gets (W.stack . W.workspace . W.current . windowset)

-- | update Group to follow changes in the workspace
updateGroup :: Ord a => Maybe (W.Stack a) -> Groups a -> Groups a
updateGroup mst gs =
let flatten = concatMap W.integrate . M.elems
news = W.integrate' mst \\ flatten gs
deads = flatten gs \\ W.integrate' mst

uniNew = M.union (M.fromList $ map (\n -> (n,single n)) news)
single x = W.Stack x [] []

-- pass through a list to update/remove keys
remDead = M.fromList . map (\w -> (W.focus w,w))
. mapMaybe (W.filter (`notElem` deads)) . M.elems

-- update the current tab group's order and focus
followFocus hs = fromMaybe hs $ do
f' <- W.focus <$> mst
xs <- find (elem f' . W.integrate) $ M.elems hs
xs' <- W.filter (`elem` W.integrate xs) =<< mst
return $ M.insert f' xs' $ M.delete (W.focus xs) hs

in remDead $ uniNew $ followFocus gs
updateGroup Nothing _ = mempty
updateGroup (Just st) gs = fromGroupStack (toGroupStack gs st)

-- | rearrange the windowset to put the groups of tabs next to eachother, so
-- that the stack of tabs stays put.
Expand All @@ -441,20 +427,49 @@ updateWs = windowsMaybe . updateWs'

updateWs' :: Groups Window -> WindowSet -> Maybe WindowSet
updateWs' gs ws = do
f <- W.peek ws
let w = W.index ws
nes = concatMap W.integrate $ mapMaybe (flip M.lookup gs) w
ws' = W.focusWindow f $ foldr W.insertUp (foldr W.delete' ws nes) nes
guard $ W.index ws' /= W.index ws
return ws'
w <- W.stack . W.workspace . W.current $ ws
let w' = flattenGroupStack . toGroupStack gs $ w
guard $ w /= w'
pure $ W.modify' (const w') ws

-- | Flatten a stack of stacks.
flattenGroupStack :: GroupStack a -> W.Stack a
flattenGroupStack (W.Stack (W.Stack f lf rf) ls rs) =
let l = lf ++ concatMap (reverse . W.integrate) ls
r = rf ++ concatMap W.integrate rs
in W.Stack f l r

-- | Extract Groups from a stack of stacks.
fromGroupStack :: (Ord a) => GroupStack a -> Groups a
fromGroupStack = M.fromList . map (W.focus &&& id) . W.integrate

-- | Arrange a stack of windows into a stack of stacks, according to (possibly
-- outdated) Groups.
toGroupStack :: (Ord a) => Groups a -> W.Stack a -> GroupStack a
toGroupStack gs st@(W.Stack f ls rs) =
W.Stack (let Just f' = lu f in f') (mapMaybe lu ls) (mapMaybe lu rs)
where
wset = S.fromList (W.integrate st)
dead = W.filter (`S.member` wset) -- drop dead windows or entire groups
refocus s | f `elem` W.integrate s -- sync focus/order of current group
= W.filter (`elem` W.integrate s) st
| otherwise = pure s
gs' = mapGroups (refocus <=< dead) gs
gset = S.fromList . concatMap W.integrate . M.elems $ gs'
-- after refocus, f is either the focused window of some group, or not in
-- gs' at all, so `lu f` is never Nothing
lu w | w `S.member` gset = w `M.lookup` gs'
| otherwise = Just (W.Stack w [] []) -- singleton groups for new wins

mapGroups :: (Ord a) => (W.Stack a -> Maybe (W.Stack a)) -> Groups a -> Groups a
mapGroups f = M.fromList . map (W.focus &&& id) . mapMaybe f . M.elems

-- | focusWindow'. focus an element of a stack, is Nothing if that element is
-- absent. See also 'W.focusWindow'
focusWindow' :: (Eq a) => a -> W.Stack a -> Maybe (W.Stack a)
focusWindow' w st = do
guard $ not $ null $ filter (w==) $ W.integrate st
if W.focus st == w then Just st
else focusWindow' w $ W.focusDown' st
guard $ w `elem` W.integrate st
return $ until ((w ==) . W.focus) W.focusDown' st

-- update only when Just
windowsMaybe :: (WindowSet -> Maybe WindowSet) -> X ()
Expand Down

0 comments on commit a622c08

Please sign in to comment.