
Comment #8 on issue 325 by vogt.adam: Layout.Spacing breaks Layout.WindowNavigation http://code.google.com/p/xmonad/issues/detail?id=325 Well try this instead for your second layout:
secondLayout = spacing 10 $ Mirror $ windowNavigation $ Tall 1 (3/100) (3/5)
Note that `Mirror' and `spacing n' are very similar in that they significantly adjust the rectangles given to windows, so you need to apply those ones after windowNavigation. But while the problem with spacing could probably be worked around in changes to windowNavigation, maybe a better way is to apply layout modifiers in such a way that avoids those conflicts:
import Data.Ord import Data.List import XMonad import XMonad.Layout.Spacing as S import XMonad.Layout.WindowNavigation
type Precedence = Int type LM a = (Layout a -> Layout a, Precedence)
applyModifiers :: (LayoutClass l a, Read (l a)) => [LM a] -> (l a -> Layout a) applyModifiers lms l = foldr ($) (Layout l) $ map fst $ sortBy (comparing snd) lms
xmonad' :: XConfig Layout -> IO () xmonad' x@XConfig{layoutHook = Layout l} = xmonad x{layoutHook = l}
mirror = (\(Layout a) -> Layout (Mirror a),1) spacing' n = (\(Layout a) -> Layout (spacing n a),1) nav = (\(Layout a) -> Layout (windowNavigation a),0)
Example:
main = xmonad' { layoutHook = applyModifiers [nav,spacing' 5,mirror] Full }
But perhaps the sort could be done at the type-level, and possibly using hlists... -- You received this message because you are listed in the owner or CC fields of this issue, or because you starred this issue. You may adjust your issue notification preferences at: http://code.google.com/hosting/settings