[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