[xmonad] Tall layout question

Adam Vogt vogt.adam at gmail.com
Thu Jul 16 22:56:38 EDT 2009


* On Thursday, July 16 2009, Pär Andersson wrote:

>Hi,
>
...
>If I could somehow set nmaster to 1 when number of windows is less than
>4 I guess that would do the trick.

First I thought of using a logHook to update the layout:

> setNMaster :: X ()
> setNMaster = do
>    n <- gets $ length . W.integrate' . W.stack . W.workspace .  W.current . windowset
>    if n >= 4 then sendMessage (IncMasterN 1)
>        else sendMessage (IncMasterN (-1))

But that would only work if we had a message to /set/ the nmaster, which we
don't. And I'd expect there to be some infinite loops, since sendMessage will
trigger another refresh, which will run the loghook again, and so on.

A more messy option that should work is to define a layout in terms of Tall,
which sets nmaster according to your specification:

> {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
> import XMonad
> import qualified XMonad.StackSet as W
>
> data TallAlt a = TallAlt { tallAltIncrement :: !Rational, tallAltRatio :: !Rational } deriving (Read, Show)
>
> instance LayoutClass TallAlt a where
>     -- this would be more cleanly done with pureLayout, but Tall has no contract that it will remain pure
>     doLayout (TallAlt i d) r st = fmap (\(x,_) -> (x,Nothing)) $ doLayout (Tall nmaster i d) r st
>         where nmaster | stlen > 3 = 2
>                       | otherwise = 1
>               stlen = length $ W.integrate st
>     pureMessage (TallAlt i d) m = (`fmap` fromMessage m) $ \x -> case x of
>         Expand -> TallAlt i (d+i)
>         Shrink -> TallAlt i (d-i)

Which you can then use with something like:

>myLayout = smartBorders (configurableNavigation noNavigateBorders $ (tiled) ||| Full)
>    where
>      tiled = TallAlt delta ratio
>      ratio = 1/2
>      delta = 3/100

Note, I didn't test this, though it does typecheck.

I think that you might be better served by layouts that take more freedom in
laying windows out, such as Mosaic, MosaicAlt, or any Resizable* variants,
however.

Adam


More information about the xmonad mailing list