[xmonad] XMonad 0.5, combo layouts, swapDown and swapUp

Dave Harrison dave at nullcube.com
Mon Dec 10 01:13:02 EST 2007


Hey all,

First up, love the new configuration method, my xmonad.hs file is now
nice and tiny :-)

Quick "maybe glitch" though, I'm using ComboLayout with Tabbed, and I
find that when I first add lots of windows to the layout the alt-tab
order is correct (also when adding windows into the middle of the
stack it's correct).  When I swapDown or swapUp _in_ the stack, the
order is correct.  But if I swapDown or swapUp at either end of the
stack the ordering goes rather pearshaped (the ordering is no longer
correct "visually" if you see what I mean).  Is this a known thing ?

My xmonad.hs is below.

Cheers,
Dave

----

import XMonad hiding (Tall(..))
import qualified XMonad.StackSet as W
import XMonad.Layout.Tabbed
import XMonad.Layout.Combo
import XMonad.Layout.TwoPane
import XMonad.Layout.NoBorders
import XMonad.Layout.HintedTile
import XMonad.Config (defaultConfig)
import XMonad.Hooks.DynamicLog
import XMonad.Util.Dmenu

import qualified Data.Map as M
import System.IO (hPutStrLn)

daveConfig = defaultConfig
        {   defaultGaps     = [(0,15,0,0)]
            , logHook       = dynamicLog
            , terminal      = "xterm -fa Mono -fs 12"
            , layoutHook    = smartBorders ( combineTwo (TwoPane 0.03
0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)
||| mytab ||| tiled Tall ||| tiled Wide ||| Full )
            , keys = \c -> mykeys c `M.union` keys defaultConfig c

        }
    where
        -- layouts
        tiled = HintedTile 1 0.03 0.5
        mytab = tabbed shrinkText defaultTConf

        -- key mapping overrides
        mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $
            [((modm,            xK_Left  ), sendMessage Shrink) -- %!
Shrink the master area
            ,((modm,            xK_Right ), sendMessage Expand) -- %!
Expand the master area
            ,((modm,            xK_p     ), spawn "exe=`cat
/home/dave/.dmenulist | dmenu -b -p \"$\"` && eval \"exec $exe\"") --
@@ Launch dmenu
            ]

main = xmonad $ daveConfig


More information about the xmonad mailing list