[xmonad] how do I get a layout like this?
Karl Hasselström
kha-xmonad at hemma.treskal.com
Wed Jan 21 22:50:23 EST 2009
On 2009-01-21 23:06:29 +0100, Karl Hasselström wrote:
> Hmm, I'd like to do something like this, but cycle through the windows
> that are currently not _visible_. I've looked through the
> documentation, but I can't find any way to tell if a given window is
> currently visible.
OK, I got it working. With this, add
Sliced 2 Nothing []
to your layouts, and bind a suitable key to
focusNextUnmapped
and you're ready to go! At most two windows are shown at a time, and
the focusNextUnmapped key will cycle through the hidden windows in the
currently focused position, leaving the rest of the visible windows
alone.
I'll happily accept tips on making this code less ugly -- this is the
first useful piece of Haskell code I've ever written ...
-+-
data (Show a, Read a) => Sliced a
= Sliced Int -- number of windows visible
(Maybe a) -- focused window
[Maybe a] -- visible windows
deriving (Show, Read)
fillInBlanks :: [Maybe a] -> [a] -> [Maybe a]
fillInBlanks [] _ = []
fillInBlanks xs [] = xs
fillInBlanks ((Just x):xs) ys = (Just x):(fillInBlanks xs ys)
fillInBlanks (Nothing:xs) (y:ys) = (Just y):(fillInBlanks xs ys)
instance (Eq a, Show a, Read a) => LayoutClass Sliced a where
doLayout (Sliced numVisible focused visible) rect st =
return (tile, Just $ next) where
wasFocused w = case focused of
Just f -> w == f
Nothing -> False
fixLength v = take numVisible $ v ++ noth
where noth = Nothing : noth
switchToNewFocused v =
if (Just $ SS.focus st) `elem` v
then v
else map repl v
where repl Nothing = Nothing
repl (Just w) = Just (if wasFocused w
then (SS.focus st) else w)
replaceEmptyWithFocused v =
if (Just $ SS.focus st) `elem` v then v
else fillInBlanks v [SS.focus st]
replaceRightmostWithFocused v =
if (Just $ SS.focus st) `elem` v then v
else reverse $ (Just $ SS.focus st) : (tail $ reverse v)
removeDeleted v = map filt v
where filt Nothing = Nothing
filt (Just w) = if w `elem` (SS.integrate st)
then (Just w) else Nothing
fillEmptySlots v = fillInBlanks v hidden
where hidden = filter (`notElem` (catMaybes v))
(SS.integrate st)
visible' = fillEmptySlots $ removeDeleted
$ replaceRightmostWithFocused $ replaceEmptyWithFocused
$ switchToNewFocused $ fixLength visible
tile = zip toDraw $ splitHorizontally (length toDraw) rect
where toDraw = catMaybes visible'
next = Sliced numVisible (Just $ SS.focus st) visible'
handleMessage (Sliced numVisible focused visible) x =
return $ case fromMessage x of
Just Shrink -> Just (Sliced (numVisible - 1) focused visible)
Just Expand -> Just (Sliced (numVisible + 1) focused visible)
_ -> Nothing
description _ = "Sliced"
-- Shift focus one step.
shiftOne :: SS.Stack a -> SS.Stack a
shiftOne (SS.Stack t ls (r:rs)) = SS.Stack r (t:ls) rs
shiftOne (SS.Stack t ls []) = SS.Stack x [] xs
where (x:xs) = reverse (t:ls)
-- Shift focus to next unmapped window.
focusNextUnmapped :: X ()
focusNextUnmapped = do
state <- get
let visible = mapped state
Op.windows $ SS.modify' $ skipWindows visible
where skipWindows wins st@(SS.Stack t _ _) =
if S.member t wins then skipWindows wins' st' else st
where wins' = S.delete t wins
st' = shiftOne st
--
Karl Hasselström, kha at treskal.com
www.treskal.com/kalle
More information about the xmonad
mailing list