README: spelling

This is important if the hook is slow (e.g. try adding "float w"
to the window-dragging hook), as it allows xmonad to keep up with
the motion of the mouse.

Config.hs

@@ -8,12 +8,12 @@
 -- Stability   :  stable
 -- Portability :  portable
 -- 
-------------------------------------------------------------------------
 --
 -- This module specifies configurable defaults for xmonad. If you change
--- values here, be sure to recompile and restart (mod-shift-ctrl-q) xmonad,
+-- values here, be sure to recompile and restart (mod-q) xmonad,
 -- for the changes to take effect.
 -- 
+------------------------------------------------------------------------
 
 module Config where
 
@@ -22,42 +22,45 @@ module Config where
 --
 import XMonad
 import Operations
+import qualified StackSet as W
 import Data.Ratio
 import Data.Bits ((.|.))
 import qualified Data.Map as M
 import System.Exit
 import Graphics.X11.Xlib
 
--- The number of workspaces (virtual screens)
-workspaces :: Int
-workspaces = 9
+--
+-- The number of workspaces (virtual screens, or window groups)
+--
+workspaces :: [WorkspaceId]
+workspaces = [0..8]
 
--- modMask lets you specify which modkey you want to use. The default is mod1Mask
--- ("left alt").  You may also consider using mod3Mask ("right alt"), which
--- does not conflict with emacs keybindings. The "windows key" is usually
--- mod4Mask.
+-- |
+-- modMask lets you specify which modkey you want to use. The default is
+-- mod1Mask ("left alt").  You may also consider using mod3Mask ("right
+-- alt"), which does not conflict with emacs keybindings. The "windows
+-- key" is usually mod4Mask.
 --
 modMask :: KeyMask
 modMask = mod1Mask
 
--- When resizing a window, this ratio specifies by what percent to
--- resize in a single step
-defaultDelta :: Rational
-defaultDelta = 3%100
-
--- The default number of windows in the master area
-defaultWindowsInMaster :: Int
-defaultWindowsInMaster = 1
-
+-- |
 -- Default offset of drawable screen boundaries from each physical screen.
 -- Anything non-zero here will leave a gap of that many pixels on the
--- given edge, on the that screen. A useful gap at top of screen for a menu bar (e.g. 15)
+-- given edge, on the that screen. A useful gap at top of screen for a
+-- menu bar (e.g. 15)
+-- 
+-- An example, to set a top gap on monitor 1, and a gap on the bottom of
+-- monitor 2, you'd use a list of geometries like so:
+--
+-- > defaultGaps = [(18,0,0,0),(0,18,0,0)] -- 2 gaps on 2 monitors
 --
 -- Fields are: top, bottom, left, right.
 --
 defaultGaps :: [(Int,Int,Int,Int)]
 defaultGaps = [(0,0,0,0)] -- 15 for default dzen
 
+-- |
 -- numlock handling:
 --
 -- The mask for the numlock key. You may need to change this on some systems.
@@ -71,29 +74,57 @@ defaultGaps = [(0,0,0,0)] -- 15 for default dzen
 numlockMask :: KeyMask
 numlockMask = mod2Mask
 
+-- |
 -- Border colors for unfocused and focused windows, respectively.
+--
 normalBorderColor, focusedBorderColor :: String
 normalBorderColor  = "#dddddd"
 focusedBorderColor = "#ff0000"
 
+-- |
 -- Width of the window border in pixels
+--
 borderWidth :: Dimension
 borderWidth = 1
 
--- The default set of Layouts:
-defaultLayouts :: [Layout]
-defaultLayouts = [ tall defaultWindowsInMaster defaultDelta (1%2)
-                 , wide defaultWindowsInMaster defaultDelta (1%2)
-                 , full ]
-
+-- |
+-- The default set of tiling algorithms
 --
+defaultLayouts :: [Layout Window]
+defaultLayouts = [ tiled , mirror tiled , full ]
+  where
+     -- default tiling algorithm partitions the screen into two panes
+     tiled   = tall nmaster delta ratio
+
+     -- The default number of windows in the master pane
+     nmaster = 1
+
+     -- Default proportion of screen occupied by master pane
+     ratio   = 1%2
+
+     -- Percent of screen to increment by when resizing panes
+     delta   = 3%100
+
+-- |
+-- Perform an arbitrary action on each state change.
+-- Examples include:
+--      * do nothing
+--      * log the state to stdout
+--
+logHook :: X ()
+logHook = return ()
+
+-- |
 -- The key bindings list.
 -- 
+-- The unusual comment format is used to generate the documentation
+-- automatically.
+--
 keys :: M.Map (KeyMask, KeySym) (X ())
 keys = M.fromList $
     -- launching and killing programs
     [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") -- @@ Launch an xterm
-    , ((modMask,               xK_p     ), spawn "exe=`dmenu_path | dmenu` && exec $exe") -- @@ Launch dmenu
+    , ((modMask,               xK_p     ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- @@ Launch dmenu
     , ((modMask .|. shiftMask, xK_p     ), spawn "gmrun") -- @@ Launch gmrun
     , ((modMask .|. shiftMask, xK_c     ), kill) -- @@ Close the focused window
 
@@ -115,6 +146,8 @@ keys = M.fromList $
     , ((modMask,               xK_h     ), sendMessage Shrink) -- @@ Shrink the master area
     , ((modMask,               xK_l     ), sendMessage Expand) -- @@ Expand the master area
 
+    , ((modMask,               xK_t     ), withFocused sink) -- @@ Push window back into tiling
+
     -- increase or decrease number of windows in the master area
     , ((modMask              , xK_comma ), sendMessage (IncMasterN 1)) -- @@ Increment the number of windows in the master area
     , ((modMask              , xK_period), sendMessage (IncMasterN (-1))) -- @@ Deincrement the number of windows in the master area
@@ -123,19 +156,31 @@ keys = M.fromList $
     , ((modMask              , xK_b     ), modifyGap (\i n -> let x = (defaultGaps ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- @@ Toggle the status bar gap
 
     -- quit, or restart
-    , ((modMask .|. shiftMask, xK_q                     ), io (exitWith ExitSuccess)) -- @@ Quit xmonad
+    , ((modMask .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- @@ Quit xmonad
     , ((modMask              , xK_q     ), restart Nothing True) -- @@ Restart xmonad
 
     ] ++
     -- mod-[1..9] @@ Switch to workspace N
     -- mod-shift-[1..9] @@ Move client to workspace N
     [((m .|. modMask, k), f i)
-        | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..]
+        | (i, k) <- zip workspaces [xK_1 ..]
         , (f, m) <- [(view, 0), (shift, shiftMask)]]
 
     -- mod-{w,e,r} @@ Switch to physical/Xinerama screens 1, 2, or 3
     -- mod-shift-{w,e,r} @@ Move client to screen 1, 2, or 3
     ++
-    [((m .|. modMask, key), screenWorkspace sc >>= f)
+    [((m .|. modMask, key), screenWorkspace sc >>= flip whenJust f)
         | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
-        , (f, m) <- [(view, 0), (shift, shiftMask)]]
+        , (f, m) <- [(windows . W.view, 0), (shift, shiftMask)]]
+
+-- |
+-- default actions bound to mouse events
+--
+mouseBindings :: M.Map (KeyMask, Button) (Window -> X ())
+mouseBindings = M.fromList $
+    -- mod-button1 @@ Set the window to floating mode and move by dragging
+    [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))
+    -- mod-button2 @@ Raise the window to the top of the stack
+    , ((modMask, button2), (\w -> focus w >> swapMaster))
+    -- mod-button3 @@ Set the window to floating mode and resize by dragging
+    , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w)) ]

Config.hs-boot

@@ -1,3 +1,8 @@
 module Config where
 import Graphics.X11.Xlib.Types (Dimension)
+import Graphics.X11.Xlib (KeyMask)
+import XMonad
 borderWidth :: Dimension
+logHook     :: X ()
+numlockMask :: KeyMask
+workspaces :: [WorkspaceId]

Main.hs

@@ -8,14 +8,18 @@
 -- Stability   :  unstable
 -- Portability :  not portable, uses mtl, X11, posix
 --
------------------------------------------------------------------------------
---
 -- xmonad, a minimalist, tiling window manager for X11
 -- 
+-----------------------------------------------------------------------------
+
+module Main where
 
 import Data.Bits
 import qualified Data.Map as M
+import qualified Data.Set as S
 import Control.Monad.Reader
+import Control.Monad.State
+import Data.Maybe (fromMaybe)
 
 import System.Environment (getArgs)
 
@@ -25,46 +29,44 @@ import Graphics.X11.Xinerama    (getScreenInfo)
 
 import XMonad
 import Config
-import StackSet (new)
-import Operations   (manage, unmanage, focus, setFocusX, full, isClient, rescreen)
+import StackSet (new, floating, member, findIndex, workspace, tag, current, visible)
+import qualified StackSet as W
+import Operations
 
---
+import System.IO
+
+-- |
 -- The main entry point
 --
 main :: IO ()
 main = do
     dpy   <- openDisplay ""
     let dflt = defaultScreen dpy
-        initcolor c = fst `liftM` allocNamedColor dpy (defaultColormap dpy dflt) c
 
     rootw  <- rootWindow dpy dflt
-    wmdelt <- internAtom dpy "WM_DELETE_WINDOW" False
-    wmprot <- internAtom dpy "WM_PROTOCOLS"     False
     xinesc <- getScreenInfo dpy
-    nbc    <- initcolor normalBorderColor
-    fbc    <- initcolor focusedBorderColor
+    nbc    <- initColor dpy normalBorderColor
+    fbc    <- initColor dpy focusedBorderColor
+    hSetBuffering stdout NoBuffering
     args <- getArgs
 
     let winset | ("--resume" : s : _) <- args
                , [(x, "")]            <- reads s = x
-               | otherwise = new (fromIntegral workspaces) (fromIntegral $ length xinesc)
-        safeLayouts = case defaultLayouts of [] -> (full, []); (x:xs) -> (x, xs)
+               | otherwise = new workspaces $ zipWith SD xinesc gaps
+        gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0)
+
+        safeLayouts = case defaultLayouts of [] -> (full, []); (x:xs) -> (x,xs)
         cf = XConf
             { display       = dpy
             , theRoot       = rootw
-            , wmdelete      = wmdelt
-            , wmprotocols   = wmprot
-            -- fromIntegral needed for X11 versions that use Int instead of CInt.
             , normalBorder  = nbc
-            , focusedBorder = fbc
-            }
+            , focusedBorder = fbc }
         st = XState
             { windowset     = winset
-            , layouts       = M.fromList [(w, safeLayouts) | w <- [0 .. W workspaces - 1]]
-            , statusGaps    = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0)
-            , xineScreens   = xinesc
-            , dimensions    = (fromIntegral (displayWidth  dpy dflt),
-                               fromIntegral (displayHeight dpy dflt)) }
+            , layouts       = M.fromList [(w, safeLayouts) | w <- workspaces]
+            , mapped        = S.empty
+            , waitingUnmap  = M.empty
+            , dragging      = Nothing }
 
     xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
 
@@ -73,12 +75,27 @@ main = do
     selectInput dpy rootw $  substructureRedirectMask .|. substructureNotifyMask
                          .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
     grabKeys dpy rootw
+    grabButtons dpy rootw
+
     sync dpy False
 
-    ws <- scan dpy rootw
+    ws <- scan dpy rootw -- on the resume case, will pick up new windows
     allocaXEvent $ \e ->
         runX cf st $ do
-            mapM_ manage ws
+
+            -- walk workspace, resetting X states/mask for windows
+            -- TODO, general iterators for these lists.
+            sequence_ [ setInitialProperties w >> reveal w
+                      | wk <- map W.workspace (W.current winset : W.visible winset)
+                      , w  <- W.integrate' (W.stack wk) ]
+
+            sequence_ [ setInitialProperties w >> hide w
+                      | wk <- W.hidden winset
+                      , w  <- W.integrate' (W.stack wk) ]
+
+            mapM_ manage ws -- find new windows
+            refresh
+
             -- main loop, for all you HOF/recursion fans out there.
             forever $ handle =<< io (nextEvent dpy e >> getEvent e)
 
@@ -88,29 +105,42 @@ main = do
 -- IO stuff. Doesn't require any X state
 -- Most of these things run only on startup (bar grabkeys)
 
--- | scan for any initial windows to manage
+-- | scan for any new windows to manage. If they're already managed,
+-- this should be idempotent.
 scan :: Display -> Window -> IO [Window]
 scan dpy rootw = do
     (_, _, ws) <- queryTree dpy rootw
     filterM ok ws
-
+  -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==
+  -- Iconic
   where ok w = do wa <- getWindowAttributes dpy w
+                  a  <- internAtom dpy "WM_STATE" False
+                  p  <- getWindowProperty32 dpy a w
+                  let ic = case p of
+                            Just (3:_) -> True -- 3 for iconified
+                            _          -> False
                   return $ not (wa_override_redirect wa)
-                         && wa_map_state wa == waIsViewable
+                         && (wa_map_state wa == waIsViewable || ic)
 
 -- | Grab the keys back
 grabKeys :: Display -> Window -> IO ()
 grabKeys dpy rootw = do
     ungrabKey dpy anyKey anyModifier rootw
-    flip mapM_ (M.keys keys) $ \(mask,sym) -> do
+    forM_ (M.keys keys) $ \(mask,sym) -> do
          kc <- keysymToKeycode dpy sym
          -- "If the specified KeySym is not defined for any KeyCode,
          -- XKeysymToKeycode() returns zero."
-         when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) $
-            [0, numlockMask, lockMask, numlockMask .|. lockMask]
+         when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers
 
   where grab kc m = grabKey dpy kc m rootw True grabModeAsync grabModeAsync
 
+grabButtons :: Display -> Window -> IO ()
+grabButtons dpy rootw = do
+    ungrabButton dpy anyButton anyModifier rootw
+    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) extraModifiers) (M.keys mouseBindings)
+  where grab button mask = grabButton dpy button mask rootw False buttonPressMask
+                                      grabModeAsync grabModeSync none none
+
 -- ---------------------------------------------------------------------
 -- | Event handler. Map X events onto calls into Operations.hs, which
 -- modify our internal model of the window manager state.
@@ -128,25 +158,57 @@ handle :: Event -> X ()
 handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
     | t == keyPress = withDisplay $ \dpy -> do
         s  <- io $ keycodeToKeysym dpy code 0
-        whenJust (M.lookup (complement (numlockMask .|. lockMask) .&. m,s) keys) id
+        whenJust (M.lookup (cleanMask m,s) keys) id
 
 -- manage a new window
 handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
     wa <- io $ getWindowAttributes dpy w -- ignore override windows
-    when (not (wa_override_redirect wa)) $ manage w
+    -- need to ignore mapping requests by managed windows not on the current workspace
+    managed <- isClient w
+    when (not (wa_override_redirect wa) && not managed) $ do manage w
 
 -- window destroyed, unmanage it
 -- window gone,      unmanage it
 handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w
-handle (UnmapEvent         {ev_window = w}) = whenX (isClient w) $ unmanage w
+
+-- We track expected unmap events in waitingUnmap.  We ignore this event unless
+-- it is synthetic or we are not expecting an unmap notification from a window.
+handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
+    e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
+    if (synthetic || e == 0)
+        then unmanage w
+        else modify (\s -> s { waitingUnmap = M.adjust pred w (waitingUnmap s) })
 
 -- set keyboard mapping
 handle e@(MappingNotifyEvent {ev_window = w}) = do
     io $ refreshKeyboardMapping e
     when (ev_request e == mappingKeyboard) $ withDisplay $ io . flip grabKeys w
 
+-- handle button release, which may finish dragging.
+handle e@(ButtonEvent {ev_event_type = t})
+    | t == buttonRelease = do
+    drag <- gets dragging
+    case drag of
+        -- we're done dragging and have released the mouse:
+        Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f
+        Nothing    -> broadcastMessage e
+
+-- handle motionNotify event, which may mean we are dragging.
+handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do
+    drag <- gets dragging
+    case drag of
+        Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging
+        Nothing -> broadcastMessage e
+
 -- click on an unfocused window, makes it focused on this workspace
-handle (ButtonEvent {ev_window = w, ev_event_type = t}) | t == buttonPress = focus w
+handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
+    | t == buttonPress = do
+    -- If it's the root window, then it's something we
+    -- grabbed in grabButtons. Otherwise, it's click-to-focus.
+    isr <- isRoot w
+    if isr then whenJust (M.lookup (cleanMask (ev_state e), b) mouseBindings) ($ ev_subwindow e)
+           else focus w
+    sendMessage e -- Always send button events.
 
 -- entered a normal window, makes this focused.
 handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
@@ -160,20 +222,33 @@ handle e@(CrossingEvent {ev_event_type = t})
          when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw
 
 -- configure a window
-handle e@(ConfigureRequestEvent {}) = withDisplay $ \dpy -> do
-    io $ configureWindow dpy (ev_window e) (ev_value_mask e) $ WindowChanges
-        { wc_x            = ev_x e
-        , wc_y            = ev_y e
-        , wc_width        = ev_width e
-        , wc_height       = ev_height e
-        , wc_border_width = ev_border_width e
-        , wc_sibling      = ev_above e
-        -- this fromIntegral is only necessary with the old X11 version that uses
-        -- Int instead of CInt.  TODO delete it when there is a new release of X11
-        , wc_stack_mode   = fromIntegral $ ev_detail e }
+handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
+    ws <- gets windowset
+    wa <- io $ getWindowAttributes dpy w
+
+    -- TODO temporary workaround for some bugs in float.  Don't call 'float' on
+    -- windows that aren't visible, because it changes the focused screen
+    let vis = any ((== findIndex w ws) . Just . tag . workspace) (current ws : visible ws)
+    if (M.member w (floating ws) && vis)
+        || not (member w ws)
+        then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges
+                    { wc_x            = ev_x e
+                    , wc_y            = ev_y e
+                    , wc_width        = ev_width e
+                    , wc_height       = ev_height e
+                    , wc_border_width = fromIntegral borderWidth
+                    , wc_sibling      = ev_above e
+                    , wc_stack_mode   = ev_detail e }
+                when (member w ws) (float w)
+        else io $ allocaXEvent $ \ev -> do
+                 setEventType ev configureNotify
+                 setConfigureEvent ev w w
+                     (wa_x wa) (wa_y wa) (wa_width wa)
+                     (wa_height wa) (ev_border_width e) none (wa_override_redirect wa)
+                 sendEvent dpy w False 0 ev
     io $ sync dpy False
 
 -- the root may have configured
 handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen
 
-handle _ = return () -- trace (eventName e) -- ignoring
+handle e = broadcastMessage e -- trace (eventName e) -- ignoring

Operations.hs

@@ -1,5 +1,6 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
+{-# OPTIONS -fno-warn-orphans -fglasgow-exts #-}
+-- \^^ deriving Typeable
+-- --------------------------------------------------------------------------
 -- |
 -- Module      :  Operations.hs
 -- Copyright   :  (c) Spencer Janssen 2007
@@ -7,7 +8,9 @@
 -- 
 -- Maintainer  :  dons@cse.unsw.edu.au
 -- Stability   :  unstable
--- Portability :  not portable, mtl, posix
+-- Portability :  not portable, Typeable deriving, mtl, posix
+--
+-- Operations.
 --
 -----------------------------------------------------------------------------
 
@@ -15,40 +18,65 @@ module Operations where
 
 import XMonad
 import qualified StackSet as W
-import {-# SOURCE #-} Config (borderWidth)
+import {-# SOURCE #-} Config (borderWidth,logHook,numlockMask)
 
 import Data.Maybe
-import Data.List            (genericIndex, intersectBy)
-import Data.Bits            ((.|.))
+import Data.List            (nub, (\\), find)
+import Data.Bits            ((.|.), (.&.), complement)
+import Data.Ratio
 import qualified Data.Map as M
+import qualified Data.Set as S
 
--- import System.Mem (performGC)
 import Control.Monad.State
 import Control.Monad.Reader
-import Control.Arrow
+import Control.Arrow ((***), first, second)
 
+import System.IO
 import Graphics.X11.Xlib
 import Graphics.X11.Xinerama (getScreenInfo)
 import Graphics.X11.Xlib.Extras
 
--- ---------------------------------------------------------------------
--- Window manager operations
+import qualified Data.Traversable as T
 
--- | manage. Add a new window to be managed in the current workspace.
--- Bring it into focus. If the window is already managed, nothing happens.
+-- ---------------------------------------------------------------------
+-- |
+-- Window manager operations
+-- manage. Add a new window to be managed in the current workspace.
+-- Bring it into focus.
+--
+-- Whether the window is already managed, or not, it is mapped, has its
+-- border set, and its event mask set.
 --
 manage :: Window -> X ()
-manage w = do
-    withDisplay $ \d -> io $ do
-        selectInput d w $ structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
-        mapWindow d w
-        setWindowBorderWidth d w borderWidth
-    windows $ W.insertUp w
+manage w = whenX (fmap not $ isClient w) $ withDisplay $ \d -> do
+    setInitialProperties w >> reveal w
+
+    -- FIXME: This is pretty awkward. We can't can't let "refresh" happen
+    -- before the call to float, because that will resize the window and
+    -- lose the default sizing.
+
+    sh <- io $ getWMNormalHints d w
+    let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
+    isTransient <- isJust `liftM` io (getTransientForHint d w)
+    if isFixedSize || isTransient
+        then do modify $ \s -> s { windowset = W.insertUp w (windowset s) }
+                float w -- \^^ now go the refresh.
+        else windows $ W.insertUp w
 
 -- | unmanage. A window no longer exists, remove it from the window
 -- list, on whatever workspace it is.
+--
+-- FIXME: clearFloating should be taken care of in W.delete, but if we do it
+-- there, floating status is lost when moving windows between workspaces,
+-- because W.shift calls W.delete.
+--
+-- should also unmap?
+--
 unmanage :: Window -> X ()
-unmanage = windows . W.delete
+unmanage w = do
+    windows (W.sink w . W.delete w)
+    setWMState w 0 {-withdrawn-}
+    modify (\s -> s {mapped = S.delete w (mapped s), waitingUnmap = M.delete w (waitingUnmap s)})
 
 -- | focus. focus window up or down. or swap various windows.
 focusUp, focusDown, swapUp, swapDown, swapMaster :: X ()
@@ -60,22 +88,20 @@ swapMaster = windows W.swapMaster
 
 -- | shift. Move a window to a new workspace, 0 indexed.
 shift :: WorkspaceId -> X ()
-shift n = withFocused hide >> windows (W.shift n)
-    -- refresh will raise it if we didn't need to move it.
+shift n = windows (W.shift n)
 
 -- | view. Change the current workspace to workspace at offset n (0 indexed).
 view :: WorkspaceId -> X ()
-view = windows . W.view
+view = windows . W.greedyView
 
 -- | Modify the size of the status gap at the top of the current screen
 -- Taking a function giving the current screen, and current geometry.
 modifyGap :: (Int -> (Int,Int,Int,Int) -> (Int,Int,Int,Int)) -> X ()
 modifyGap f = do
-    XState { windowset = ws, statusGaps = gaps } <- get
-    let n       = fromIntegral $ W.screen (W.current ws)
-        (a,i:b) = splitAt n gaps
-    modify $ \s -> s { statusGaps = a ++ f n i : b }
-    refresh
+    windows $ \ws@(W.StackSet { W.current = c@(W.Screen { W.screenDetail = sd }) }) ->
+        let n = fromIntegral . W.screen $ c
+            g = f n . statusGap $ sd
+        in ws { W.current = c { W.screenDetail = sd { statusGap = g } } }
 
 -- | Kill the currently focused client. If we do kill it, we'll get a
 -- delete notify back from X.
@@ -85,7 +111,8 @@ modifyGap f = do
 --
 kill :: X ()
 kill = withDisplay $ \d -> withFocused $ \w -> do
-    XConf {wmdelete = wmdelt, wmprotocols = wmprot} <- ask
+    wmdelt <- atom_WM_DELETE_WINDOW  ;  wmprot <- atom_WM_PROTOCOLS
+
     protocols <- io $ getWMProtocols d w
     io $ if wmdelt `elem` protocols
         then allocaXEvent $ \ev -> do
@@ -97,33 +124,103 @@ kill = withDisplay $ \d -> withFocused $ \w -> do
 -- ---------------------------------------------------------------------
 -- Managing windows
 
+data UnDoLayout = UnDoLayout deriving ( Typeable, Eq )
+instance Message UnDoLayout
+
 -- | windows. Modify the current window list with a pure function, and refresh
 windows :: (WindowSet -> WindowSet) -> X ()
 windows f = do
-    old  <- gets windowset
-    let new = f old
-    modify (\s -> s { windowset = new })
-    refresh
+    -- Notify visible layouts to remove decorations etc
+    -- We cannot use sendMessage because this must not call refresh ever,
+    -- and must be called on all visible workspaces.
+    broadcastMessage UnDoLayout
+    XState { windowset = old, layouts = fls } <- get
+    let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old
+        ws = f old
+    modify (\s -> s { windowset = ws })
+    d <- asks display
 
-    -- We now go to some effort to compute the minimal set of windows to hide.
-    -- The minimal set being only those windows which weren't previously hidden,
-    -- which is the intersection of previously visible windows with those now hidden
-    mapM_ hide . concatMap (integrate . W.stack) $
-        intersectBy (\w x -> W.tag w == W.tag x)
-            (map W.workspace $ W.current old : W.visible old)
-            (W.hidden new)
+    -- for each workspace, layout the currently visible workspaces
+    let allscreens     = W.current ws : W.visible ws
+        summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens
+    visible <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do
+        let n      = W.tag (W.workspace w)
+            this   = W.view n ws
+            Just l = fmap fst $ M.lookup n fls
+            flt = filter (flip M.member (W.floating ws)) (W.index this)
+            tiled = (W.stack . W.workspace . W.current $ this)
+                    >>= W.filter (not . flip M.member (W.floating ws))
+                    >>= W.filter (not . (`elem` vis))
+            (SD (Rectangle sx sy sw sh)
+                (gt,gb,gl,gr))          = W.screenDetail w
+            viewrect = Rectangle (sx + fromIntegral gl)        (sy + fromIntegral gt)
+                                 (sw - fromIntegral (gl + gr)) (sh - fromIntegral (gt + gb))
 
-    clearEnterEvents
+        -- just the tiled windows:
+        -- now tile the windows on this workspace, modified by the gap
+        (rs, ml') <- runLayout l viewrect tiled `catchX` runLayout full viewrect tiled
+        mapM_ (uncurry tileWindow) rs
+        whenJust ml' $ \l' -> modify $ \ss ->
+                              ss { layouts = M.adjust (first (const l')) n (layouts ss) }
 
-    -- TODO: move this into StackSet.  This isn't exactly the usual integrate.
- where integrate W.Empty        = []
-       integrate (W.Node x l r) = x : l ++ r
+        -- now the floating windows:
+        -- move/resize the floating windows, if there are any
+        forM_ flt $ \fw -> whenJust (M.lookup fw (W.floating ws)) $
+          \(W.RationalRect rx ry rw rh) -> do
+            tileWindow fw $ Rectangle
+                (sx + floor (toRational sw*rx)) (sy + floor (toRational sh*ry))
+                (floor (toRational sw*rw)) (floor (toRational sh*rh))
 
--- | hide. Hide a window by moving it off screen.
+        let vs = flt ++ map fst rs
+        io $ restackWindows d vs
+        -- return the visible windows for this workspace:
+        return vs
+
+    setTopFocus
+    logHook
+    -- io performGC -- really helps, but seems to trigger GC bugs?
+
+    -- hide every window that was potentially visible before, but is not
+    -- given a position by a layout now.
+    mapM_ hide (nub oldvisible \\ visible)
+
+    clearEvents enterWindowMask
+
+-- | setWMState.  set the WM_STATE property
+setWMState :: Window -> Int -> X ()
+setWMState w v = withDisplay $ \dpy -> do
+    a <- atom_WM_STATE
+    io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none]
+
+-- | hide. Hide a window by unmapping it, and setting Iconified.
 hide :: Window -> X ()
-hide w = withDisplay $ \d -> do
-    (sw,sh) <- gets dimensions
-    io $ moveWindow d w sw sh
+hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
+    io $ do selectInput d w (clientMask .&. complement structureNotifyMask)
+            unmapWindow d w
+            selectInput d w clientMask
+    setWMState w 3 --iconic
+    -- this part is key: we increment the waitingUnmap counter to distinguish
+    -- between client and xmonad initiated unmaps.
+    modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s)
+                    , mapped       = S.delete w (mapped s) })
+
+-- | reveal. Show a window by mapping it and setting Normal
+-- this is harmless if the window was already visible
+reveal :: Window -> X ()
+reveal w = withDisplay $ \d -> do
+    setWMState w 1 --normal
+    io $ mapWindow d w
+    modify (\s -> s { mapped = S.insert w (mapped s) })
+
+-- | The client events that xmonad is interested in
+clientMask :: EventMask
+clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
+
+-- | Set some properties when we initially gain control of a window
+setInitialProperties :: Window -> X ()
+setInitialProperties w = withDisplay $ \d -> io $ do
+    selectInput d w $ clientMask
+    setWindowBorderWidth d w borderWidth
 
 -- | refresh. Render the currently visible workspaces, as determined by
 -- the StackSet. Also, set focus to the focused window.
@@ -132,47 +229,27 @@ hide w = withDisplay $ \d -> do
 -- with X calls.
 --
 refresh :: X ()
-refresh = do
-    XState { windowset = ws, layouts = fls, xineScreens = xinesc, statusGaps = gaps } <- get
-    d <- asks display
+refresh = windows id
 
-    -- for each workspace, layout the currently visible workspaces
-    (`mapM_` (W.current ws : W.visible ws)) $ \w -> do
-        let n      = W.tag (W.workspace w)
-            this   = W.view n ws
-            Just l = fmap fst $ M.lookup n fls
-            (Rectangle sx sy sw sh) = genericIndex xinesc (W.screen w)
-            (gt,gb,gl,gr)           = genericIndex gaps   (W.screen w)
-
-        -- now tile the windows on this workspace, modified by the gap
-        rs <- doLayout l (Rectangle (sx + fromIntegral gl)
-                                    (sy + fromIntegral gt)
-                                    (sw - fromIntegral (gl + gr))
-                                    (sh - fromIntegral (gt + gb))) (W.index this)
-        mapM_ (\(win,rect) -> io (tileWindow d win rect)) rs
-
-        -- and raise the focused window if there is one.
-        whenJust (W.peek this) $ io . raiseWindow d
-
-    setTopFocus
-    clearEnterEvents
---  io performGC -- really helps 
-
--- | clearEnterEvents.  Remove all window entry events from the event queue.
-clearEnterEvents :: X ()
-clearEnterEvents = withDisplay $ \d -> io $ do
+-- | clearEvents.  Remove all events of a given type from the event queue.
+clearEvents :: EventMask -> X ()
+clearEvents mask = withDisplay $ \d -> io $ do
     sync d False
     allocaXEvent $ \p -> fix $ \again -> do
-        more <- checkMaskEvent d enterWindowMask p
+        more <- checkMaskEvent d mask p
         when more again -- beautiful
 
 -- | tileWindow. Moves and resizes w such that it fits inside the given
 -- rectangle, including its border.
-tileWindow :: Display -> Window -> Rectangle -> IO ()
-tileWindow d w r = do
-    bw <- (fromIntegral . wa_border_width) `liftM` getWindowAttributes d w
-    moveResizeWindow d w (rect_x r) (rect_y r)
-                         (rect_width  r - bw*2) (rect_height r - bw*2)
+tileWindow :: Window -> Rectangle -> X ()
+tileWindow w r = withDisplay $ \d -> do
+    bw <- (fromIntegral . wa_border_width) `liftM` io (getWindowAttributes d w)
+    -- give all windows at least 1x1 pixels
+    let least x | x <= bw*2  = 1
+                | otherwise  = x - bw*2
+    io $ moveResizeWindow d w (rect_x r) (rect_y r)
+                              (least $ rect_width r) (least $ rect_height r)
+    reveal w
 
 -- ---------------------------------------------------------------------
 
@@ -182,67 +259,57 @@ rescreen :: X ()
 rescreen = do
     xinesc <- withDisplay (io . getScreenInfo)
 
-    -- TODO: This stuff is necessary because Xlib apparently caches screen
-    -- width/height.  Find a better solution later.  I hate Xlib.
-    let sx = maximum $ map (\r -> rect_x r + fromIntegral (rect_width  r)) xinesc
-        sy = maximum $ map (\r -> rect_y r + fromIntegral (rect_height r)) xinesc
-
-    modify (\s -> s { xineScreens = xinesc , dimensions  = (sx, sy)
-                    , statusGaps  = take (length xinesc) $ (statusGaps s) ++ repeat (0,0,0,0) })
-
     windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
-        let (x:xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs
-        in  ws { W.current = W.Screen x 0
-               , W.visible = zipWith W.Screen xs [1 ..]
+        let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs
+            (a:as)   = zipWith3 W.Screen xs [0..] $ zipWith SD xinesc gs
+            sgs      = map (statusGap . W.screenDetail) (v:vs)
+            gs       = take (length xinesc) (sgs ++ repeat (0,0,0,0))
+        in  ws { W.current = a
+               , W.visible = as
                , W.hidden  = ys }
 
 -- ---------------------------------------------------------------------
 
-buttonsToGrab :: [Button]
-buttonsToGrab = [button1, button2, button3]
-
 -- | setButtonGrab. Tell whether or not to intercept clicks on a given window
 setButtonGrab :: Bool -> Window -> X ()
-setButtonGrab grab w = withDisplay $ \d -> io $ (`mapM_` buttonsToGrab) $ \b ->
-    if grab then grabButton d b anyModifier w False (buttonPressMask .|. buttonReleaseMask)
-                   grabModeAsync grabModeSync none none
-            else ungrabButton d b anyModifier w
+setButtonGrab grab w = withDisplay $ \d -> io $
+    if grab
+        then forM_ [button1, button2, button3] $ \b ->
+            grabButton d b anyModifier w False buttonPressMask
+                       grabModeAsync grabModeSync none none
+        else ungrabButton d anyButton anyModifier w
 
 -- ---------------------------------------------------------------------
 -- Setting keyboard focus
 
 -- | Set the focus to the window on top of the stack, or root
 setTopFocus :: X ()
-setTopFocus = withWorkspace $ maybe (setFocusX =<< asks theRoot) setFocusX . W.peek
+setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.peek
 
 -- | Set focus explicitly to window 'w' if it is managed by us, or root.
 -- This happens if X notices we've moved the mouse (and perhaps moved
 -- the mouse to a new screen).
 focus :: Window -> X ()
-focus w = withWorkspace $ \s -> do
-    if W.member w s then modify (\st -> st { windowset = W.focusWindow w s }) >> setFocusX w -- >> refresh
-                    else whenX (isRoot w) $ setFocusX w -- we could refresh here, moving gap too.
-    -- XXX a focus change could be caused by switching workspaces in xinerama.
-    -- if so, and the gap is in use, the gap should probably follow the
-    -- cursor to the new screen. 
-    --
-    -- to get the gap though, you need to trigger a refresh.
+focus w = withWindowSet $ \s -> do
+    if W.member w s then when (W.peek s /= Just w) $ windows (W.focusWindow w)
+                    else whenX (isRoot w) $ setFocusX w
 
 -- | Call X to set the keyboard focus details.
 setFocusX :: Window -> X ()
-setFocusX w = withWorkspace $ \ws -> do
+setFocusX w = withWindowSet $ \ws -> do
     XConf { display = dpy , normalBorder = nbc, focusedBorder = fbc } <- ask
 
     -- clear mouse button grab and border on other windows
-    (`mapM_` (W.current ws : W.visible ws)) $ \wk -> do
-        (`mapM_` (W.index (W.view (W.tag (W.workspace wk)) ws))) $ \otherw -> do
+    forM_ (W.current ws : W.visible ws) $ \wk -> do
+        forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw -> do
             setButtonGrab True otherw
-            io $ setWindowBorder dpy otherw (color_pixel nbc)
+            io $ setWindowBorder dpy otherw nbc
 
+    -- If we ungrab buttons on the root window, we lose our mouse bindings.
+    whenX (not `liftM` isRoot w) $ setButtonGrab False w
     io $ do setInputFocus dpy w revertToPointerRoot 0
             -- raiseWindow dpy w
-    setButtonGrab False w
-    io $ setWindowBorder dpy w (color_pixel fbc)
+    io $ setWindowBorder dpy w fbc
 
 -- ---------------------------------------------------------------------
 -- Managing layout
@@ -254,23 +321,42 @@ setFocusX w = withWorkspace $ \ws -> do
 -- becomes a master. When switching back , the focused window is
 -- uppermost.
 --
+-- Note that the new layout's deconstructor will be called, so it should be
+-- idempotent.
 switchLayout :: X ()
-switchLayout = layout (\(x, xs) -> let xs' = xs ++ [x] in (head xs', tail xs'))
+switchLayout = do
+    broadcastMessage UnDoLayout  -- calling refresh now would defeat the point of deconstruction
+    n <- gets (W.tag . W.workspace . W.current . windowset)
+    modify $ \s -> s { layouts = M.adjust switch n (layouts s) }
+    refresh
+ where switch (x, xs) = let xs' =  xs ++ [x] in (head xs', tail xs')
 
--- | Throw an (extensible) message value to the current Layout scheme,
--- possibly modifying how we layout the windows, then refresh.
---
--- TODO, this will refresh on Nothing.
+-- | Throw a message to the current Layout possibly modifying how we
+-- layout the windows, then refresh.
 --
 sendMessage :: Message a => a -> X ()
-sendMessage a = layout $ \x@(l, ls) -> maybe x (flip (,) ls) (modifyLayout l (SomeMessage a))
+sendMessage a = do n <- (W.tag . W.workspace . W.current) `fmap` gets windowset
+                   Just (l,ls) <- M.lookup n `fmap` gets layouts
+                   ml' <- modifyLayout l (SomeMessage a) `catchX` return (Just l)
+                   whenJust ml' $ \l' -> do modify $ \s -> s { layouts = M.insert n (l',ls) (layouts s) }
+                                            refresh
+
+-- | Send a message to all visible layouts, without necessarily refreshing.
+-- This is how we implement the hooks, such as UnDoLayout.
+broadcastMessage :: Message a => a -> X ()
+broadcastMessage a = do
+    ol <- gets layouts
+    nl <- T.forM ol $ \ (l,ls) -> maybe (l,ls) (flip (,) ls) `fmap`
+          (modifyLayout l (SomeMessage a) `catchX` return (Just l))
+    modify $ \s -> s { layouts = nl }
+
+instance Message Event
 
 --
 -- Builtin layout algorithms:
 --
 --   fullscreen mode
 --   tall mode
---   wide mode
 -- 
 -- The latter algorithms support the following operations:
 --
@@ -278,85 +364,218 @@ sendMessage a = layout $ \x@(l, ls) -> maybe x (flip (,) ls) (modifyLayout l (So
 --      Expand
 --
 
-data Resize = Shrink | Expand deriving Typeable
+data Resize     = Shrink | Expand   deriving Typeable
+data IncMasterN = IncMasterN Int   deriving Typeable
 instance Message Resize
-
-data IncMasterN = IncMasterN Int deriving Typeable
 instance Message IncMasterN
 
-full :: Layout
-full = Layout { doLayout     = \sc ws -> return [ (w,sc) | w <- ws ]
-              , modifyLayout = const Nothing } -- no changes
-
-tall, wide :: Int -> Rational -> Rational -> Layout
-wide nmaster delta frac = mirrorLayout (tall nmaster delta frac)
+-- simple fullscreen mode, just render all windows fullscreen.
+-- a plea for tuple sections: map . (,sc)
+full :: Layout a
+full = Layout { doLayout     = \sc (W.Stack f _ _) -> return ([(f, sc)],Nothing)
+              , modifyLayout = const (return Nothing) } -- no changes
 
+--
+-- The tiling mode of xmonad, and its operations.
+--
+tall :: Int -> Rational -> Rational -> Layout a
 tall nmaster delta frac =
-    Layout { doLayout     = \r -> return . ap zip (tile frac r nmaster . length)
-           , modifyLayout = \m -> fmap resize     (fromMessage m) `mplus`
-                                  fmap incmastern (fromMessage m) }
+    Layout { doLayout     = \r -> return . (\x->(x,Nothing)) .
+                                  ap zip (tile frac r nmaster . length) . W.integrate
+           , modifyLayout = \m -> return $ msum [fmap resize     (fromMessage m)
+                                                ,fmap incmastern (fromMessage m)] }
 
-    where resize Shrink = tall nmaster delta (frac-delta)
-          resize Expand = tall nmaster delta (frac+delta)
-          incmastern (IncMasterN d) = tall (max 1 (nmaster+d)) delta frac
+    where resize Shrink = tall nmaster delta (max 0 $ frac-delta)
+          resize Expand = tall nmaster delta (min 1 $ frac+delta)
+          incmastern (IncMasterN d) = tall (max 0 (nmaster+d)) delta frac
 
 -- | Mirror a rectangle
 mirrorRect :: Rectangle -> Rectangle
 mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
 
--- | Mirror a layout
-mirrorLayout :: Layout -> Layout
-mirrorLayout (Layout { doLayout = dl, modifyLayout = ml }) =
-              Layout { doLayout = \sc w -> map (second mirrorRect) `fmap` dl (mirrorRect sc) w
-                     , modifyLayout = fmap mirrorLayout . ml }
+-- | Mirror a layout, compute its 90 degree rotated form.
+mirror :: Layout a -> Layout a
+mirror (Layout { doLayout = dl, modifyLayout = ml }) =
+    Layout { doLayout     = \sc w -> do (wrs, ml') <- dl (mirrorRect sc) w
+                                        return (map (second mirrorRect) wrs, mirror `fmap` ml')
+           , modifyLayout = fmap (fmap mirror) . ml }
 
--- | tile.  Compute the positions for windows in our default tiling modes
--- Tiling algorithms in the core should satisify the constraint that
+-- | tile.  Compute the positions for windows using the default 2 pane tiling algorithm.
 --
---  * no windows overlap
---  * no gaps exist between windows.
+-- The screen is divided (currently) into two panes. all clients are
+-- then partioned between these two panes. one pane, the `master', by
+-- convention has the least number of windows in it (by default, 1). 
+-- the variable `nmaster' controls how many windows are rendered in the
+-- master pane. 
+--
+-- `delta' specifies the ratio of the screen to resize by.
+--
+-- 'frac' specifies what proportion of the screen to devote to the
+-- master area.
 -- 
 tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
-tile f r nmaster n | n <= nmaster = splitVertically n r
-                   | otherwise    = splitVertically nmaster r1 ++ splitVertically (n-nmaster) r2
-    where (r1,r2) = splitHorizontallyBy f r
+tile f r nmaster n = if n <= nmaster || nmaster == 0
+    then splitVertically n r
+    else splitVertically nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns
+  where (r1,r2) = splitHorizontallyBy f r
 
+--
+-- Divide the screen vertically into n subrectangles
+--
 splitVertically, splitHorizontally :: Int -> Rectangle -> [Rectangle]
 splitVertically n r | n < 2 = [r]
 splitVertically n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :
     splitVertically (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))
-    where smallh = sh `div` fromIntegral n
-splitHorizontally n r = map mirrorRect $ splitVertically n $ mirrorRect r
+  where smallh = sh `div` fromIntegral n --hmm, this is a fold or map.
 
-splitHorizontallyBy, splitVerticallyBy :: Rational -> Rectangle -> (Rectangle, Rectangle)
+splitHorizontally n = map mirrorRect . splitVertically n . mirrorRect
+
+-- Divide the screen into two rectangles, using a rational to specify the ratio
+splitHorizontallyBy, splitVerticallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
 splitHorizontallyBy f (Rectangle sx sy sw sh) =
-    (Rectangle sx sy leftw sh, Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)
-        where leftw = floor $ fromIntegral sw * f
-splitVerticallyBy f r = (\(a,b)->(mirrorRect a,mirrorRect b)) $ splitHorizontallyBy f $ mirrorRect r
+    ( Rectangle sx sy leftw sh
+    , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)
+  where leftw = floor $ fromIntegral sw * f
 
-------------------------------------------------------------------------
-
--- | layout. Modify the current workspace's layout with a pure
--- function and refresh.
-layout :: ((Layout, [Layout]) -> (Layout, [Layout])) -> X ()
-layout f = do
-    modify $ \s ->
-        let n          = W.tag . W.workspace . W.current . windowset $ s
-            (Just fl)  = M.lookup n $ layouts s
-        in s { layouts = M.insert n (f fl) (layouts s) }
-    refresh
+splitVerticallyBy f = (mirrorRect *** mirrorRect) . splitHorizontallyBy f . mirrorRect
 
 ------------------------------------------------------------------------
 -- Utilities
 
--- | Return workspace visible on screen 'sc', or 0.
-screenWorkspace :: ScreenId -> X WorkspaceId
-screenWorkspace sc = withWorkspace $ return . fromMaybe 0 . W.lookupWorkspace sc
+-- | Return workspace visible on screen 'sc', or Nothing.
+screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)
+screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc
 
 -- | Apply an X operation to the currently focused window, if there is one.
 withFocused :: (Window -> X ()) -> X ()
-withFocused f = withWorkspace $ \w -> whenJust (W.peek w) f
+withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f
 
 -- | True if window is under management by us
 isClient :: Window -> X Bool
-isClient w = withWorkspace $ return . W.member w
+isClient w = withWindowSet $ return . W.member w
+
+-- | Combinations of extra modifier masks we need to grab keys\/buttons for.
+-- (numlock and capslock)
+extraModifiers :: [KeyMask]
+extraModifiers = [0, numlockMask, lockMask, numlockMask .|. lockMask ]
+
+-- | Strip numlock\/capslock from a mask
+cleanMask :: KeyMask -> KeyMask
+cleanMask = (complement (numlockMask .|. lockMask) .&.)
+
+-- | Get the Pixel value for a named color
+initColor :: Display -> String -> IO Pixel
+initColor dpy c = (color_pixel . fst) `liftM` allocNamedColor dpy colormap c
+    where colormap = defaultColormap dpy (defaultScreen dpy)
+
+------------------------------------------------------------------------
+-- | Floating layer support
+
+-- | Make a floating window tiled
+sink :: Window -> X ()
+sink = windows . W.sink
+
+-- | Make a tiled window floating, using its suggested rectangle
+--
+-- TODO: float changes the set of visible workspaces when we call it for an
+-- invisible window -- this should not happen.  See 'temporary workaround' in
+-- the handler for ConfigureRequestEvent also.
+float :: Window -> X ()
+float w = withDisplay $ \d -> do
+    ws <- gets windowset
+    wa <- io $ getWindowAttributes d w
+
+    let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.current ws : W.visible ws
+        sr = screenRect . W.screenDetail $ sc
+        sw = W.tag . W.workspace $ sc
+        bw = fi . wa_border_width $ wa
+
+    windows $ maybe id W.focusWindow (W.peek ws) . W.shift sw . W.focusWindow w . W.float w
+        (W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
+                        ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
+                        (fi (wa_width  wa + bw*2) % fi (rect_width sr))
+                        (fi (wa_height wa + bw*2) % fi (rect_height sr)))
+  where fi x = fromIntegral x
+        pointWithin :: Integer -> Integer -> Rectangle -> Bool
+        pointWithin x y r = x >= fi (rect_x r) &&
+                            x <  fi (rect_x r) + fi (rect_width r) &&
+                            y >= fi (rect_y r) &&
+                            y <  fi (rect_y r) + fi (rect_height r)
+
+-- ---------------------------------------------------------------------
+-- Mouse handling
+
+-- | Accumulate mouse motion events
+mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
+mouseDrag f done = do
+    drag <- gets dragging
+    case drag of
+        Just _ -> return () -- error case? we're already dragging
+        Nothing -> do
+            XConf { theRoot = root, display = d } <- ask
+            io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
+                    grabModeAsync grabModeAsync none none currentTime
+            modify $ \s -> s { dragging = Just (motion, cleanup) }
+ where
+    cleanup = do
+        withDisplay $ io . flip ungrabPointer currentTime
+        modify $ \s -> s { dragging = Nothing }
+        done
+    motion x y = do z <- f x y
+                    clearEvents pointerMotionMask
+                    return z
+
+mouseMoveWindow :: Window -> X ()
+mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w
+    let ox = fromIntegral ox'
+        oy = fromIntegral oy'
+    mouseDrag (\ex ey -> io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
+                                             (fromIntegral (fromIntegral (wa_y wa) + (ey - oy))))
+              (float w)
+
+mouseResizeWindow :: Window -> X ()
+mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    sh <- io $ getWMNormalHints d w
+    io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
+    mouseDrag (\ex ey -> do
+                 io $ resizeWindow d w `uncurry`
+                    applySizeHints sh ((fromIntegral (max 1 (ex - fromIntegral (wa_x wa)))),
+                                      (fromIntegral (max 1 (ey - fromIntegral (wa_y wa))))))
+              (float w)
+
+-- ---------------------------------------------------------------------
+-- | Support for window size hints
+
+type D = (Dimension, Dimension)
+
+-- | Reduce the dimensions if needed to comply to the given SizeHints.
+applySizeHints :: SizeHints -> D -> D
+applySizeHints sh =
+      maybe id applyMaxSizeHint                   (sh_max_size   sh)
+    . maybe id (\(bw, bh) (w, h) -> (w+bw, h+bh)) (sh_base_size  sh)
+    . maybe id applyResizeIncHint                 (sh_resize_inc sh)
+    . maybe id applyAspectHint                    (sh_aspect     sh)
+    . maybe id (\(bw,bh) (w,h)   -> (w-bw, h-bh)) (sh_base_size  sh)
+
+-- | Reduce the dimensions so their aspect ratio falls between the two given aspect ratios.
+applyAspectHint :: (D, D) -> D -> D
+applyAspectHint ((minx, miny), (maxx, maxy)) x@(w,h)
+    | or [minx < 1, miny < 1, maxx < 1, maxy < 1] = x
+    | w * maxy > h * maxx                         = (h * maxx `div` maxy, h)
+    | w * miny < h * minx                         = (w, w * miny `div` minx)
+    | otherwise                                   = x
+
+-- | Reduce the dimensions so they are a multiple of the size increments.
+applyResizeIncHint :: D -> D -> D
+applyResizeIncHint (iw,ih) x@(w,h) =
+    if iw > 0 && ih > 0 then (w - w `mod` iw, h - h `mod` ih) else x
+
+-- | Reduce the dimensions if they exceed the given maximum dimensions.
+applyMaxSizeHint  :: D -> D -> D
+applyMaxSizeHint (mw,mh) x@(w,h) =
+    if mw > 0 && mh > 0 then (min w mw,min h mh) else x

README

@@ -44,34 +44,53 @@ Get the dependencies
     whether you've got a package run 'ghc-pkg list some_package_name'
 
     mtl             http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mtl-1.0
-        (Included with GHC)
-
     unix            http://hackage.haskell.org/cgi-bin/hackage-scripts/package/unix-2.0 
-        (Included with GHC)
-
     X11             http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-1.2.2
-        (Included with GHC)
-
-    X11-extras:     http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-extras-0.2
+    X11-extras:     http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-extras-0.3
 
 And then build with Cabal:
 
-    runhaskell Setup.lhs configure --prefix=/home/dons
+    runhaskell Setup.lhs configure --prefix=$HOME
     runhaskell Setup.lhs build
     runhaskell Setup.lhs install --user
 
 ------------------------------------------------------------------------
 
+Notes for using the darcs version
+
+    If you're building the darcs version of xmonad, be sure to also
+    use the darcs version of X11-extras, which is developed concurrently
+    with xmonad.
+
+        darcs get http://darcs.haskell.org/~sjanssen/X11-extras
+
+    Not using X11-extras from darcs, is the most common reason for the
+    darcs version of xmonad to fail to build.
+
+------------------------------------------------------------------------
+
 Running xmonad:
 
     Add:
 
-         exec /home/dons/bin/xmonad
+         $HOME/bin/xmonad
 
     to the last line of your .xsession or .xinitrc file.
 
 ------------------------------------------------------------------------
 
+XMonadContrib
+
+    There are various contributed modules that can be used with xmonad.
+    Examples include an ion3-like tabbed layout, a prompt/program launcher,
+    and various other useful modules.  XMonadContrib is available at:
+
+    0.3 release:   http://www.xmonad.org/XMonadContrib-0.3.tar.gz
+
+    darcs version: darcs get http://darcs.haskell.org/~sjanssen/XMonadContrib
+
+------------------------------------------------------------------------
+
 Other useful programs:
 
  For a program dispatch menu:

StackSet.hs

@@ -8,9 +8,39 @@
 -- Stability   :  experimental
 -- Portability :  portable, Haskell 98
 --
------------------------------------------------------------------------------
---
--- ** Introduction
+
+module StackSet (
+        -- * Introduction
+        -- $intro
+        StackSet(..), Workspace(..), Screen(..), StackOrNot, Stack(..), RationalRect(..),
+        -- *  Construction
+        -- $construction
+        new, view, greedyView,
+        -- * Xinerama operations
+        -- $xinerama
+        lookupWorkspace,
+        -- *  Operations on the current stack
+        -- $stackOperations
+        peek, index, integrate, integrate', differentiate,
+        focusUp, focusDown,
+        focusWindow, tagMember, member, findIndex,
+        -- * Modifying the stackset
+        -- $modifyStackset
+        insertUp, delete, filter,
+        -- * Setting the master window
+        -- $settingMW
+        swapMaster, swapUp, swapDown, modify, modify', float, sink, -- needed by users
+        -- * Composite operations
+        -- $composite
+        shift
+    ) where
+
+import Prelude hiding (filter)
+import Data.Maybe   (listToMaybe)
+import qualified Data.List as L (delete,deleteBy,find,splitAt,filter)
+import qualified Data.Map  as M (Map,insert,delete,empty)
+
+-- $intro
 --
 -- The 'StackSet' data type encodes a window manager abstraction. The
 -- window manager is a set of virtual workspaces. On each workspace is a
@@ -19,17 +49,17 @@
 -- workspace is the one which will take user input. It can be visualised
 -- as follows:
 -- 
---  Workspace  { 0*}   { 1 }   { 2 }   { 3 }   { 4 }
---  
---  Windows    [1      []      [3*     [6*]    []
---             ,2*]            ,4
---                             ,5]
+-- > Workspace  { 0*}   { 1 }   { 2 }   { 3 }   { 4 }
+-- > 
+-- > Windows    [1      []      [3*     [6*]    []
+-- >            ,2*]            ,4
+-- >                            ,5]
 -- 
 -- Note that workspaces are indexed from 0, windows are numbered
 -- uniquely. A '*' indicates the window on each workspace that has
 -- focus, and which workspace is current.
 --
--- ** Zipper 
+-- Zipper 
 --
 -- We encode all the focus tracking directly in the data structure, with a 'zipper':
 --
@@ -42,7 +72,7 @@
 --    resulting data structure will share as much of its components with
 --    the old structure as possible. 
 --
---      Oleg Kiselyov, 27 Apr 2005, haskell@, "Zipper as a delimited continuation"
+--      Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"
 --
 -- We use the zipper to keep track of the focused workspace and the
 -- focused window on each workspace, allowing us to have correct focus
@@ -58,7 +88,7 @@
 --
 --      The Zipper, Haskell wikibook
 -- 
--- ** Xinerama support:
+-- Xinerama support:
 --
 -- Xinerama in X11 lets us view multiple virtual workspaces
 -- simultaneously. While only one will ever be in focus (i.e. will
@@ -67,89 +97,100 @@
 -- (viewed) on which physical screens. We use a simple Map Workspace
 -- Screen for this.
 --
--- ** Master and Focus
+-- Master and Focus
 --
 -- Each stack tracks a focused item, and for tiling purposes also tracks
 -- a 'master' position. The connection between 'master' and 'focus'
 -- needs to be well defined. Particular in relation to 'insert' and
 -- 'delete'.
 --
-module StackSet (
-        StackSet(..), Workspace(..), Screen(..), Stack(..),
-        new, view, lookupWorkspace, peek, index, focusUp, focusDown,
-        focusWindow, member, findIndex, insertUp, delete, shift,
-        swapMaster, swapUp, swapDown, modify -- needed by users
-    ) where
-
-import Data.Maybe   (listToMaybe)
-import qualified Data.List as L (delete,find,genericSplitAt)
-
 
+-- | 
 -- API changes from xmonad 0.1:
---  StackSet constructor arguments changed. StackSet workspace window screen
---  new,                    -- was: empty
---  view,
---  index,
---  peek,                   -- was: peek/peekStack
---  focusUp, focusDown,  -- was: rotate
---  swapUp, swapDown
---  focus                   -- was: raiseFocus
---  insertUp,             -- was: insert/push
---  delete,
---  swapMaster,             -- was: promote/swap
---  member, 
---  shift,
---  lookupWorkspace,        -- was: workspace
---  visibleWorkspaces       -- gone.
+-- StackSet constructor arguments changed. StackSet workspace window screen
+--
+-- * new,                    -- was: empty
+--
+-- * view,
+--
+-- * index,
+--
+-- * peek,                   -- was: peek\/peekStack
+--
+-- * focusUp, focusDown,  -- was: rotate
+--
+-- * swapUp, swapDown
+--
+-- * focus                   -- was: raiseFocus
+--
+-- * insertUp,             -- was: insert\/push
+--
+-- * delete,
+--
+-- * swapMaster,             -- was: promote\/swap
+--
+-- * member, 
+--
+-- * shift,
+--
+-- * lookupWorkspace,        -- was: workspace
+--
+-- * visibleWorkspaces       -- gone.
 --
 ------------------------------------------------------------------------
-
---
+-- |
 -- A cursor into a non-empty list of workspaces. 
+-- 
 -- We puncture the workspace list, producing a hole in the structure
 -- used to track the currently focused workspace. The two other lists
 -- that are produced are used to track those workspaces visible as
 -- Xinerama screens, and those workspaces not visible anywhere.
---
-data StackSet i a sid =
-    StackSet { size    :: !i                -- number of workspaces
-             , current :: !(Screen i a sid) -- currently focused workspace
-             , visible :: [Screen i a sid]  -- non-focused workspaces, visible in xinerama
-             , hidden  :: [Workspace i a]   -- workspaces not visible anywhere
+
+data StackSet i a sid sd =
+    StackSet { current  :: !(Screen i a sid sd)    -- ^ currently focused workspace
+             , visible  :: [Screen i a sid sd]     -- ^ non-focused workspaces, visible in xinerama
+             , hidden   :: [Workspace i a]      -- ^ workspaces not visible anywhere
+             , floating :: M.Map a RationalRect -- ^ floating windows
              } deriving (Show, Read, Eq)
 
--- Visible workspaces, and their Xinerama screens.
-data Screen i a sid = Screen { workspace :: !(Workspace i a), screen :: !sid }
+-- | Visible workspaces, and their Xinerama screens.
+data Screen i a sid sd = Screen { workspace :: !(Workspace i a)
+                                , screen :: !sid
+                                , screenDetail :: !sd }
     deriving (Show, Read, Eq)
 
--- 
+-- |
 -- A workspace is just a tag - its index - and a stack
 --
-data Workspace i a = Workspace  { tag :: !i, stack :: Stack a }
+data Workspace i a = Workspace  { tag :: !i, stack :: StackOrNot a }
     deriving (Show, Read, Eq)
 
--- 
+data RationalRect = RationalRect Rational Rational Rational Rational
+    deriving (Show, Read, Eq)
+
+-- |
 -- A stack is a cursor onto a (possibly empty) window list.
 -- The data structure tracks focus by construction, and
 -- the master window is by convention the top-most item.
 -- Focus operations will not reorder the list that results from
 -- flattening the cursor. The structure can be envisaged as:
 --
---     +-- master:  < '7' >
---  up |            [ '2' ]
---     +---------   [ '3' ]
---  focus:          < '4' >
---  dn +----------- [ '8' ]
+-- >    +-- master:  < '7' >
+-- > up |            [ '2' ]
+-- >    +---------   [ '3' ]
+-- > focus:          < '4' >
+-- > dn +----------- [ '8' ]
 --
 -- A 'Stack' can be viewed as a list with a hole punched in it to make
--- the focused position. Under the zipper/calculus view of such
+-- the focused position. Under the zipper\/calculus view of such
 -- structures, it is the differentiation of a [a], and integrating it
 -- back has a natural implementation used in 'index'.
 --
-data Stack a = Empty
-             | Node { focus  :: !a        -- focused thing in this set
-                    , up     :: [a]       -- clowns to the left
-                    , down   :: [a] }     -- jokers to the right
+type StackOrNot a = Maybe (Stack a)
+
+data Stack a = Stack { focus  :: !a        -- focused thing in this set
+                     , up     :: [a]       -- clowns to the left
+                     , down   :: [a] }     -- jokers to the right
     deriving (Show, Read, Eq)
 
 
@@ -158,99 +199,152 @@ abort :: String -> a
 abort x = error $ "xmonad: StackSet: " ++ x
 
 -- ---------------------------------------------------------------------
--- Construction
+-- $construction
 
--- | /O(n)/. Create a new stackset, of empty stacks, of size 'n', with
--- 'm' physical screens. 'm' should be less than or equal to 'n'.
--- The workspace with index '0' will be current.
+-- | /O(n)/. Create a new stackset, of empty stacks, with given tags, with
+-- 'm' physical screens. 'm' should be less than or equal to the number of
+-- workspace tags.  The first workspace in the list will be current.
 --
 -- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
 --
-new :: (Integral i, Integral s) => i -> s -> StackSet i a s
-new n m | n > 0 && m > 0 = StackSet n cur visi unseen
-        | otherwise      = abort "non-positive arguments to StackSet.new"
-
-  where (seen,unseen) = L.genericSplitAt m $ Workspace 0 Empty : [ Workspace i Empty | i <- [1 ..n-1]]
-        (cur:visi)    = [ Screen i s |  (i,s) <- zip seen [0..] ]
+new :: (Integral s) => [i] -> [sd] -> StackSet i a s sd
+new wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty
+  where (seen,unseen) = L.splitAt (length m) $ map (flip Workspace Nothing) wids
+        (cur:visi)    = [ Screen i s sd |  (i, s, sd) <- zip3 seen [0..] m ]
                 -- now zip up visibles with their screen id
+new _ _ = abort "non-positive argument to StackSet.new"
 
--- 
--- /O(w)/. Set focus to the workspace with index 'i'. 
+
+
+-- |
+-- /O(w)/. Set focus to the workspace with index \'i\'. 
 -- If the index is out of range, return the original StackSet.
 --
 -- Xinerama: If the workspace is not visible on any Xinerama screen, it
 -- becomes the current screen. If it is in the visible list, it becomes
 -- current.
 
--- is raised to the current screen. If it is already visible, focus is
--- just moved.
---
-view :: (Eq i, Eq a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s
+view :: (Eq a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd
 view i s
-    | i < 0 && i >= size s || i == tag (workspace (current s)) = s  -- out of bounds or current
+    | not (i `tagMember` s)
+      || i == tag (workspace (current s)) = s  -- out of bounds or current
 
     | Just x <- L.find ((i==).tag.workspace) (visible s)
     -- if it is visible, it is just raised
-    = s { current = x, visible = current s : L.delete x (visible s) }
+    = s { current = x, visible = current s : L.deleteBy screenEq x (visible s) }
 
-    | Just x <- L.find ((i==).tag)     (hidden  s)
+    | Just x <- L.find ((i==).tag)           (hidden  s)
     -- if it was hidden, it is raised on the xine screen currently used
-    = s { current = Screen x (screen (current s))
+    = s { current = (current s) { workspace = x }
         , hidden = workspace (current s) : L.delete x (hidden s) }
 
-    | otherwise = abort "Inconsistent StackSet: workspace not found"
+    | otherwise = s
+ where screenEq x y = screen x == screen y
 
     -- 'Catch'ing this might be hard. Relies on monotonically increasing
     -- workspace tags defined in 'new'
 
+-- |
+-- Set focus to the given workspace.  If that workspace does not exist
+-- in the stackset, the original workspace is returned.  If that workspace is
+-- 'hidden', then display that workspace on the current screen, and move the
+-- current workspace to 'hidden'.  If that workspace is 'visible' on another
+-- screen, the workspaces of the current screen and the other screen are
+-- swapped.
+
+greedyView :: (Eq a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd
+greedyView w ws
+ | any wTag (hidden ws) = view w ws
+ | (Just s) <- L.find (wTag . workspace) (visible ws)
+                        = ws { current = (current ws) { workspace = workspace s }
+                             , visible = s { workspace = workspace (current ws) }
+                                       : L.filter (not . wTag . workspace) (visible ws) }
+ | otherwise            = ws
+ where
+    wTag = (w == ) . tag
+
 -- ---------------------------------------------------------------------
--- Xinerama operations
+-- $xinerama
 
 -- | Find the tag of the workspace visible on Xinerama screen 'sc'.
 -- Nothing if screen is out of bounds.
-lookupWorkspace :: Eq s => s -> StackSet i a s -> Maybe i
-lookupWorkspace sc w = listToMaybe [ tag i | Screen i s <- current w : visible w, s == sc ]
+lookupWorkspace :: Eq s => s -> StackSet i a s sd -> Maybe i
+lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible w, s == sc ]
 
 -- ---------------------------------------------------------------------
--- Operations on the current stack
+-- $stackOperations
 
---
+-- |
 -- The 'with' function takes a default value, a function, and a
--- StackSet. If the current stack is Empty, 'with' returns the
+-- StackSet. If the current stack is Nothing, 'with' returns the
 -- default value. Otherwise, it applies the function to the stack,
 -- returning the result. It is like 'maybe' for the focused workspace.
 --
-with :: b -> (Stack a -> b) -> StackSet i a s -> b
-with dflt f s = case stack (workspace (current s)) of Empty -> dflt; v -> f v
-    -- TODO: ndm: a 'catch' proof here that 'f' only gets Node
-    --            constructors, hence all 'f's are safe below?
+with :: b -> (Stack a -> b) -> StackSet i a s sd -> b
+with dflt f = maybe dflt f . stack . workspace . current
 
+-- |
+-- Apply a function, and a default value for Nothing, to modify the current stack.
 --
--- Apply a function, and a default value for Empty, to modify the current stack.
---
-modify :: Stack a -> (Stack a -> Stack a) -> StackSet i a s -> StackSet i a s
+modify :: StackOrNot a -> (Stack a -> StackOrNot a) -> StackSet i a s sd -> StackSet i a s sd
 modify d f s = s { current = (current s)
                         { workspace = (workspace (current s)) { stack = with d f s }}}
 
+-- |
+-- Apply a function to modify the current stack if it isn't empty, and we don't
+--  want to empty it.
 --
+modify' :: (Stack a -> Stack a) -> StackSet i a s sd -> StackSet i a s sd
+modify' f = modify Nothing (Just . f)
+
+-- |
 -- /O(1)/. Extract the focused element of the current stack. 
 -- Return Just that element, or Nothing for an empty stack.
 --
-peek :: StackSet i a s -> Maybe a
+peek :: StackSet i a s sd -> Maybe a
 peek = with Nothing (return . focus)
 
+-- |
+-- /O(n)/. Flatten a Stack into a list.
 --
+integrate :: Stack a -> [a]
+integrate (Stack x l r) = reverse l ++ x : r
+
+-- |
+-- /O(n)/ Flatten a possibly empty stack into a list.
+integrate' :: StackOrNot a -> [a]
+integrate' = maybe [] integrate
+
+-- |
+-- /O(n)/. Texture a list.
+--
+differentiate :: [a] -> StackOrNot a
+differentiate [] = Nothing
+differentiate (x:xs) = Just $ Stack x [] xs
+
+-- |
+-- /O(n)/. 'filter p s' returns the elements of 's' such that 'p' evaluates to
+-- True.  Order is preserved, and focus moves as described for 'delete'.
+--
+filter :: (a -> Bool) -> Stack a -> StackOrNot a
+filter p (Stack f ls rs) = case L.filter p (f:rs) of
+    f':rs' -> Just $ Stack f' (L.filter p ls) rs'    -- maybe move focus down
+    []     -> case L.filter p ls of                  -- filter back up
+                    f':ls' -> Just $ Stack f' ls' [] -- else up
+                    []     -> Nothing
+
+-- |
 -- /O(s)/. Extract the stack on the current workspace, as a list.
 -- The order of the stack is determined by the master window -- it will be
 -- the head of the list. The implementation is given by the natural
 -- integration of a one-hole list cursor, back to a list.
 --
-index :: Eq a => StackSet i a s -> [a]
-index = with [] $ \(Node t l r) -> reverse l ++ t : r
+index :: StackSet i a s sd -> [a]
+index = with [] integrate
 
 --  let is = t : r ++ reverse l in take (length is) (dropWhile (/= m) (cycle is))
 
---
+-- |
 -- /O(1), O(w) on the wrapping case/. 
 --
 -- focusUp, focusDown. Move the window focus up or down the stack,
@@ -262,59 +356,66 @@ index = with [] $ \(Node t l r) -> reverse l ++ t : r
 -- if we reach the end. Again the wrapping model should 'cycle' on
 -- the current stack.
 -- 
-focusUp, focusDown, swapUp, swapDown :: StackSet i a s -> StackSet i a s
-focusUp = modify Empty $ \c -> case c of
-    Node _ []     [] -> c
-    Node t (l:ls) rs -> Node l ls (t:rs)
-    Node t []     rs -> Node x (xs ++ [t]) [] where (x:xs) = reverse rs
+focusUp, focusDown, swapUp, swapDown :: StackSet i a s sd -> StackSet i a s sd
+focusUp   = modify' focusUp'
+focusDown = modify' (reverseStack . focusUp' . reverseStack)
 
-focusDown = modify Empty $ \c -> case c of
-    Node _ []     [] -> c
-    Node t ls (r:rs) -> Node r (t:ls) rs
-    Node t ls     [] -> Node x [] (xs ++ [t]) where (x:xs) = reverse ls
+swapUp    = modify' swapUp'
+swapDown  = modify' (reverseStack . swapUp' . reverseStack)
 
-swapUp = modify Empty $ \c -> case c of
-    Node _ []     [] -> c
-    Node t (l:ls) rs -> Node t ls (l:rs)
-    Node t []     rs -> Node t (reverse rs) []
+focusUp', swapUp' :: Stack a -> Stack a
+focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
+focusUp' (Stack t []     rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
 
-swapDown = modify Empty $ \c -> case c of
-    Node _ []     [] -> c
-    Node t ls (r:rs) -> Node t (r:ls) rs
-    Node t ls     [] -> Node t [] (reverse ls)
+swapUp'  (Stack t (l:ls) rs) = Stack t ls (l:rs)
+swapUp'  (Stack t []     rs) = Stack t (reverse rs) []
+
+-- | reverse a stack: up becomes down and down becomes up.
+reverseStack :: Stack a -> Stack a
+reverseStack (Stack t ls rs) = Stack t rs ls
 
 --
 -- | /O(1) on current window, O(n) in general/. Focus the window 'w', 
 -- and set its workspace as current.
 --
-focusWindow :: (Integral i, Eq s, Eq a) => a -> StackSet i a s -> StackSet i a s
+focusWindow :: (Eq s, Eq a, Eq i) => a -> StackSet i a s sd -> StackSet i a s sd
 focusWindow w s | Just w == peek s = s
                 | otherwise        = maybe s id $ do
                     n <- findIndex w s
                     return $ until ((Just w ==) . peek) focusUp (view n s)
 
---
+
+
+-- | Get a list of all workspaces in the StackSet.
+workspaces :: StackSet i a s sd -> [Workspace i a]
+workspaces s = workspace (current s) : map workspace (visible s) ++ hidden s
+
+-- | Is the given tag present in the StackSet?
+tagMember :: Eq i => i -> StackSet i a s sd -> Bool
+tagMember t = elem t . map tag . workspaces
+
+-- |
 -- Finding if a window is in the stackset is a little tedious. We could
 -- keep a cache :: Map a i, but with more bookkeeping.
 --
 
 -- | /O(n)/. Is a window in the StackSet.
-member :: Eq a => a -> StackSet i a s -> Bool
+member :: Eq a => a -> StackSet i a s sd -> Bool
 member a s = maybe False (const True) (findIndex a s)
 
 -- | /O(1) on current window, O(n) in general/.
 -- Return Just the workspace index of the given window, or Nothing
 -- if the window is not in the StackSet.
-findIndex :: Eq a => a -> StackSet i a s -> Maybe i
+findIndex :: Eq a => a -> StackSet i a s sd -> Maybe i
 findIndex a s = listToMaybe
-    [ tag w | w <- workspace (current s) : map workspace (visible s) ++ hidden s, has a (stack w) ]
-    where has _ Empty         = False
-          has x (Node t l r) = x `elem` (t : l ++ r)
+    [ tag w | w <- workspaces s, has a (stack w) ]
+    where has _ Nothing         = False
+          has x (Just (Stack t l r)) = x `elem` (t : l ++ r)
 
 -- ---------------------------------------------------------------------
--- Modifying the stackset
+-- $modifyStackset
 
---
+-- |
 -- /O(n)/. (Complexity due to duplicate check). Insert a new element into
 -- the stack, above the currently focused element.
 --
@@ -328,71 +429,71 @@ findIndex a s = listToMaybe
 -- Semantics in Huet's paper is that insert doesn't move the cursor.
 -- However, we choose to insert above, and move the focus.
 --
-insertUp :: Eq a => a -> StackSet i a s -> StackSet i a s
+insertUp :: Eq a => a -> StackSet i a s sd -> StackSet i a s sd
 insertUp a s = if member a s then s else insert
-  where insert = modify (Node a [] []) (\(Node t l r) -> Node a l (t:r)) s
+  where insert = modify (Just $ Stack a [] []) (\(Stack t l r) -> Just $ Stack a l (t:r)) s
 
--- insertDown :: a -> StackSet i a s -> StackSet i a s
--- insertDown a = modify (Node a [] []) $ \(Node t l r) -> Node a (t:l) r
+-- insertDown :: a -> StackSet i a s sd -> StackSet i a s sd
+-- insertDown a = modify (Stack a [] []) $ \(Stack t l r) -> Stack a (t:l) r
 -- Old semantics, from Huet.
 -- >    w { down = a : down w }
 
---
+-- |
 -- /O(1) on current window, O(n) in general/. Delete window 'w' if it exists.
 -- There are 4 cases to consider:
 --
---   * delete on an Empty workspace leaves it Empty
+--   * delete on an Nothing workspace leaves it Nothing
 --   * otherwise, try to move focus to the down
 --   * otherwise, try to move focus to the up
---   * otherwise, you've got an empty workspace, becomes Empty
+--   * otherwise, you've got an empty workspace, becomes Nothing
 --
 -- Behaviour with respect to the master:
 --
 --   * deleting the master window resets it to the newly focused window
 --   * otherwise, delete doesn't affect the master.
 --
-delete :: (Integral i, Eq a, Eq s) => a -> StackSet i a s -> StackSet i a s
-delete w s | Just w == peek s = remove s -- common case. 
-           | otherwise = maybe s (removeWindow.tag.workspace.current $ s) (findIndex w s)
-  where
-    -- find and remove window script
-    removeWindow o n = foldr ($) s [view o,remove,view n]
-
-    -- actual removal logic, and focus/master logic:
-    remove = modify Empty $ \c ->
-      if focus c == w
-      then case c of
-        Node _ ls     (r:rs) -> Node r ls rs    -- try down first
-        Node _ (l:ls) []     -> Node l ls []    -- else up
-        Node _ []     []     -> Empty
-      else c { up = w `L.delete` up c, down = w `L.delete` down c }
+delete :: (Ord a, Eq s) => a -> StackSet i a s sd -> StackSet i a s sd
+delete w s = s { current = removeFromScreen (current s)
+               , visible = map removeFromScreen (visible s)
+               , hidden = map removeFromWorkspace (hidden s) }
+    where removeFromWorkspace ws = ws { stack = stack ws >>= filter (/=w) }
+          removeFromScreen scr = scr { workspace = removeFromWorkspace (workspace scr) }
 
 ------------------------------------------------------------------------
--- Setting the master window
 
--- /O(s)/. Set the master window to the focused window.
+-- | Given a window, and its preferred rectangle, set it as floating
+-- A floating window should already be managed by the StackSet.
+float :: Ord a => a -> RationalRect -> StackSet i a s sd -> StackSet i a s sd
+float w r s = s { floating = M.insert w r (floating s) }
+
+-- | Clear the floating status of a window
+sink :: Ord a => a -> StackSet i a s sd -> StackSet i a s sd
+sink w s = s { floating = M.delete w (floating s) }
+
+------------------------------------------------------------------------
+-- $settingMW
+
+-- | /O(s)/. Set the master window to the focused window.
 -- The old master window is swapped in the tiling order with the focused window.
 -- Focus stays with the item moved.
-swapMaster :: StackSet i a s -> StackSet i a s
-swapMaster = modify Empty $ \c -> case c of
-    Node _ [] _  -> c    -- already master.
-    Node t ls rs -> Node t [] (ys ++ x : rs) where (x:ys) = reverse ls
+swapMaster :: StackSet i a s sd -> StackSet i a s sd
+swapMaster = modify' $ \c -> case c of
+    Stack _ [] _  -> c    -- already master.
+    Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls
 
- -- natural! keep focus, move current to the top, move top to current.
-
--- ---------------------------------------------------------------------
--- Composite operations
+-- natural! keep focus, move current to the top, move top to current.
 -- 
+-- ---------------------------------------------------------------------
+-- $composite
 
--- /O(w)/. shift. Move the focused element of the current stack to stack
+-- | /O(w)/. shift. Move the focused element of the current stack to stack
 -- 'n', leaving it as the focused element on that stack. The item is
 -- inserted above the currently focused element on that workspace.  --
 -- The actual focused workspace doesn't change. If there is -- no
 -- element on the current stack, the original stackSet is returned.
 --
-shift :: (Eq a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s
-shift n s = if and [n >= 0,n < size s,n /= tag (workspace (current s))]
-            then maybe s go (peek s) else s
-    where go w = foldr ($) s [view (tag (workspace (current s))),insertUp w,view n,delete w]
-                           -- ^^ poor man's state monad :-)
-
+shift :: (Ord a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd
+shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s)
+          | otherwise                      = s
+    where go w = view curtag . insertUp w . view n . delete w $ s
+          curtag = tag (workspace (current s))

TODO

@@ -1,3 +1,12 @@
+0.3 release:
+    * stable contrib repo tarball
+    * haddocks for core and contribs on xmonad.org
+    * tag xmonad
+    * tag X11-extras
+    * tag X11
+    * more QC tests
+
+
 - possibles:
     - use more constrained type in StackSet to avoid pattern match warnings
     - audit for events handled in dwm.

XMonad.hs

@@ -9,19 +9,19 @@
 -- Stability   :  unstable
 -- Portability :  not portable, uses cunning newtype deriving
 --
------------------------------------------------------------------------------
---
 -- The X monad, a state monad transformer over IO, for the window
 -- manager state, and support routines.
 --
+-----------------------------------------------------------------------------
 
 module XMonad (
-    X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..),
-    Typeable, Message, SomeMessage(..), fromMessage,
-    runX, io, withDisplay, withWorkspace, isRoot, spawn, restart, trace, whenJust, whenX
+    X, WindowSet, WorkspaceId(..), ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..),
+    Typeable, Message, SomeMessage(..), fromMessage, runLayout,
+    runX, catchX, io, catchIO, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX,
+    atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
   ) where
 
-import StackSet (StackSet)
+import StackSet
 
 import Control.Monad.State
 import Control.Monad.Reader
@@ -30,29 +30,29 @@ import System.Posix.Process (executeFile, forkProcess, getProcessStatus, createS
 import System.Exit
 import System.Environment
 import Graphics.X11.Xlib
+-- for Read instance
+import Graphics.X11.Xlib.Extras ()
 import Data.Typeable
 
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 -- | XState, the window manager state.
 -- Just the display, width, height and a window list
 data XState = XState
-    { windowset   :: !WindowSet           -- ^ workspace list
-    , xineScreens :: ![Rectangle]         -- ^ dimensions of each screen
-    , dimensions  :: !(Position,Position) -- ^ dimensions of the screen,
-    , statusGaps  :: ![(Int,Int,Int,Int)] -- ^ width of status bar on each screen
-    , layouts     :: !(M.Map WorkspaceId (Layout, [Layout]))  }
+    { windowset    :: !WindowSet           -- ^ workspace list
+    , mapped       :: !(S.Set Window)      -- ^ the Set of mapped windows
+    , waitingUnmap :: !(M.Map Window Int)  -- ^ the number of expected UnmapEvents
+    , layouts      :: !(M.Map WorkspaceId (Layout Window, [Layout Window]))
                        -- ^ mapping of workspaces to descriptions of their layouts
-
+    , dragging     :: !(Maybe (Position -> Position -> X (), X ())) }
 data XConf = XConf
     { display       :: Display      -- ^ the X11 display
     , theRoot       :: !Window      -- ^ the root window
-    , wmdelete      :: !Atom        -- ^ window deletion atom
-    , wmprotocols   :: !Atom        -- ^ wm protocols atom
-    , normalBorder  :: !Color       -- ^ border color of unfocused windows
-    , focusedBorder :: !Color     } -- ^ border color of the focused window
+    , normalBorder  :: !Pixel       -- ^ border color of unfocused windows
+    , focusedBorder :: !Pixel     } -- ^ border color of the focused window
 
-type WindowSet = StackSet WorkspaceId Window ScreenId
+type WindowSet = StackSet WorkspaceId Window ScreenId ScreenDetail
 
 -- | Virtual workspace indicies
 newtype WorkspaceId = W Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
@@ -60,6 +60,10 @@ newtype WorkspaceId = W Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
 -- | Physical screen indicies
 newtype ScreenId    = S Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
 
+data ScreenDetail   = SD { screenRect :: !Rectangle
+                         , statusGap  :: !(Int,Int,Int,Int) -- ^ width of status bar on the screen
+                         } deriving (Eq,Show, Read)
+
 ------------------------------------------------------------------------
 
 -- | The X monad, a StateT transformer over IO encapsulating the window
@@ -77,44 +81,75 @@ newtype X a = X (ReaderT XConf (StateT XState IO) a)
 runX :: XConf -> XState -> X a -> IO ()
 runX c st (X a) = runStateT (runReaderT a c) st >> return ()
 
+-- | Run in the X monad, and in case of exception, and catch it and log it
+-- to stderr, and run the error case.
+catchX :: X a -> X a -> X a
+catchX (X job) (X errcase) = do
+    st <- get
+    c <- ask
+    (a,s') <- io ((runStateT (runReaderT job c) st) `catch`
+                  \e -> (do hPutStrLn stderr (show e); runStateT (runReaderT errcase c) st))
+    put s'
+    return a
+
 -- ---------------------------------------------------------------------
 -- Convenient wrappers to state
 
 -- | Run a monad action with the current display settings
 withDisplay :: (Display -> X a) -> X a
-withDisplay f = asks display >>= f
+withDisplay   f = asks display >>= f
 
--- | Run a monadic action with the current workspace
-withWorkspace :: (WindowSet -> X a) -> X a
-withWorkspace f = gets windowset >>= f
+-- | Run a monadic action with the current stack set
+withWindowSet :: (WindowSet -> X a) -> X a
+withWindowSet f = gets windowset >>= f
 
 -- | True if the given window is the root window
 isRoot :: Window -> X Bool
 isRoot w = liftM (w==) (asks theRoot)
 
+-- | Wrapper for the common case of atom internment
+getAtom :: String -> X Atom
+getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False
+
+-- | Common non-predefined atoms
+atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE :: X Atom
+atom_WM_PROTOCOLS       = getAtom "WM_PROTOCOLS"
+atom_WM_DELETE_WINDOW   = getAtom "WM_DELETE_WINDOW"
+atom_WM_STATE           = getAtom "WM_STATE"
+
 ------------------------------------------------------------------------
--- Layout handling
+-- | Layout handling
 
--- | The different layout modes
--- 'doLayout', a pure function to layout a Window set 'modifyLayout', 
--- 'modifyLayout' can be considered a branch of an exception handler.
+-- The different layout modes
+-- 'doLayout': given a Rectangle and a Stack, layout the stack elements
+-- inside the given Rectangle.  If an element is not given a Rectangle
+-- by 'doLayout', then it is not shown on screen.  Windows are restacked
+-- according to the order they are returned by 'doLayout'.
 --
-data Layout = Layout { doLayout     :: Rectangle -> [Window] -> X [(Window, Rectangle)]
-                     , modifyLayout :: SomeMessage -> Maybe Layout }
+-- 'modifyLayout' performs message handling for that layout.  If
+-- 'modifyLayout' returns Nothing, then the layout did not respond to
+-- that message and the screen is not refreshed.  Otherwise, 'modifyLayout'
+-- returns an updated 'Layout' and the screen is refreshed.
+--
+data Layout a = Layout { doLayout     :: Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
+                       , modifyLayout :: SomeMessage -> X (Maybe (Layout a)) }
 
--- Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/,
+runLayout :: Layout a -> Rectangle -> StackOrNot a -> X ([(a, Rectangle)], Maybe (Layout a))
+runLayout l r = maybe (return ([], Nothing)) (doLayout l r)
+
+-- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/,
 -- Simon Marlow, 2006. Use extensible messages to the modifyLayout handler.
 -- 
--- User-extensible messages must be a member of this class:
+-- User-extensible messages must be a member of this class.
 --
 class Typeable a => Message a
 
---
+-- |
 -- A wrapped value of some type in the Message class.
 --
 data SomeMessage = forall a. Message a => SomeMessage a
 
---
+-- |
 -- And now, unwrap a given, unknown Message type, performing a (dynamic)
 -- type check on the result.
 --
@@ -122,12 +157,17 @@ fromMessage :: Message m => SomeMessage -> Maybe m
 fromMessage (SomeMessage m) = cast m
 
 -- ---------------------------------------------------------------------
--- General utilities
-
--- | Lift an IO action into the X monad
+-- | General utilities
+--
+-- Lift an IO action into the X monad
 io :: IO a -> X a
 io = liftIO
 
+-- | Lift an IO action into the X monad.  If the action results in an IO
+-- exception, log the exception to stderr and continue normal execution.
+catchIO :: IO () -> X ()
+catchIO f = liftIO (f `catch` \e -> do hPutStrLn stderr (show e); hFlush stderr)
+
 -- | spawn. Launch an external application
 spawn :: String -> X ()
 spawn x = io $ do
@@ -147,10 +187,9 @@ spawn x = io $ do
 -- current window state.
 restart :: Maybe String -> Bool -> X ()
 restart mprog resume = do
-    prog <- maybe (io $ getProgName) return mprog
+    prog <- maybe (io getProgName) return mprog
     args <- if resume then gets (("--resume":) . return . show . windowset) else return []
-    io $ catch (executeFile prog True args Nothing)
-               (hPutStrLn stderr . show) -- print executable not found exception
+    catchIO (executeFile prog True args Nothing)
 
 -- | Run a side effecting action with the current workspace. Like 'when' but
 whenJust :: Maybe a -> (a -> X ()) -> X ()
@@ -160,7 +199,7 @@ whenJust mg f = maybe (return ()) f mg
 whenX :: X Bool -> X () -> X ()
 whenX a f = a >>= \b -> when b f
 
--- | Grab the X server (lock it) from the X monad
+-- Grab the X server (lock it) from the X monad
 -- withServerX :: X () -> X ()
 -- withServerX f = withDisplay $ \dpy -> do
 --     io $ grabServer dpy

man/xmonad.1.in

@@ -40,7 +40,7 @@ ___KEYBINDINGS___
 .SH EXAMPLES
 To use \fBxmonad\fR as your window manager add:
 .RS
-exec xmonad
+xmonad
 .RE
 to your \fI~/.xinitrc\fR file
 .SH CUSTOMIZATION

tests/Properties.hs

@@ -1,6 +1,7 @@
 {-# OPTIONS -fglasgow-exts #-}
 
-import StackSet
+import StackSet hiding (filter)
+import qualified StackSet as S (filter)
 import Operations (tile)
 
 import Debug.Trace
@@ -33,11 +34,13 @@ import qualified Data.Map as M
 --
 -- The all important Arbitrary instance for StackSet.
 --
-instance (Integral i, Integral s, Eq a, Arbitrary a) => Arbitrary (StackSet i a s) where
+instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary sd)
+        => Arbitrary (StackSet i a s sd) where
     arbitrary = do
         sz <- choose (1,10)     -- number of workspaces
         n  <- choose (0,sz-1)   -- pick one to be in focus
-        sc <- choose (1,sz)     -- a number of physical screens
+        sc  <- choose (1,sz)     -- a number of physical screens
+        sds <- replicateM sc arbitrary
         ls <- vector sz         -- a vector of sz workspaces
 
         -- pick a random item in each stack to focus
@@ -45,7 +48,7 @@ instance (Integral i, Integral s, Eq a, Arbitrary a) => Arbitrary (StackSet i a
                             else liftM Just (choose ((-1),length s-1))
                        | s <- ls ]
 
-        return $ fromList (fromIntegral n, fromIntegral sc,fs,ls)
+        return $ fromList (fromIntegral n, sds,fs,ls)
     coarbitrary = error "no coarbitrary for StackSet"
 
 
@@ -59,19 +62,14 @@ instance (Integral i, Integral s, Eq a, Arbitrary a) => Arbitrary (StackSet i a
 -- 'fs' random focused window on each workspace
 -- 'xs' list of list of windows
 --
-fromList :: (Integral i, Integral s, Eq a) => (i, s, [Maybe Int], [[a]]) -> StackSet i a s
+fromList :: (Integral i, Integral s, Eq a) => (i, [sd], [Maybe Int], [[a]]) -> StackSet i a s sd
 fromList (_,_,_,[]) = error "Cannot build a StackSet from an empty list"
 
-fromList (n,m,fs,xs) | n < 0 || n >= genericLength xs
-                = error $ "Cursor index is out of range: " ++ show (n, length xs)
-                  | m < 1 || m >  genericLength xs
-                = error $ "Can't have more screens than workspaces: " ++ show (m, length xs)
-
 fromList (o,m,fs,xs) =
     let s = view o $
                 foldr (\(i,ys) s ->
                     foldr insertUp (view i s) ys)
-                        (new (genericLength xs) m) (zip [0..] xs)
+                        (new [0..genericLength xs-1] m) (zip [0..] xs)
     in foldr (\f t -> case f of
                             Nothing -> t
                             Just i  -> foldr (const focusUp) t [0..i] ) s fs
@@ -81,7 +79,7 @@ fromList (o,m,fs,xs) =
 --
 -- Just generate StackSets with Char elements.
 --
-type T = StackSet Int Char Int
+type T = StackSet (NonNegative Int) Char Int Int
 
 -- Useful operation, the non-local workspaces
 hidden_spaces x = map workspace (visible x) ++ hidden x
@@ -103,7 +101,6 @@ hidden_spaces x = map workspace (visible x) ++ hidden x
 invariant (s :: T) = and
     -- no duplicates
     [ noDuplicates
-    , accurateSize
 
     -- all this xinerama stuff says we don't have the right structure
 --  , validScreens
@@ -114,10 +111,8 @@ invariant (s :: T) = and
   where
     ws = concat [ focus t : up t ++ down t
                   | w <- workspace (current s) : map workspace (visible s) ++ hidden s
-                , let t = stack w, t /= Empty ] :: [Char]
+                  , t <- maybeToList (stack w)] :: [Char]
     noDuplicates = nub ws == ws
-    calculatedSize = length (visible s) + length (hidden s) + 1   -- +1 is for current
-    accurateSize = calculatedSize == size s
 
 --  validScreens = monotonic . sort . M. . (W.current s : W.visible : W$ s
 
@@ -134,11 +129,15 @@ monotonic (x:y:zs) | x == y-1  = monotonic (y:zs)
 prop_invariant = invariant
 
 -- and check other ops preserve invariants
-prop_empty_I  (n :: Positive Int) = forAll (choose (1,fromIntegral n)) $ \m ->
-        invariant $ new (fromIntegral n) m
+prop_empty_I  (n :: Positive Int) = forAll (choose (1,fromIntegral n)) $  \m ->
+                                    forAll (vector m) $ \ms ->
+        invariant $ new [0..fromIntegral n-1] ms
 
 prop_view_I (n :: NonNegative Int) (x :: T) =
-    fromIntegral n < size x ==> invariant $ view (fromIntegral n) x
+    n `tagMember` x ==> invariant $ view (fromIntegral n) x
+
+prop_greedyView_I (n :: NonNegative Int) (x :: T) =
+    n `tagMember` x ==> invariant $ view (fromIntegral n) x
 
 prop_focusUp_I (n :: NonNegative Int) (x :: T) =
     invariant $ foldr (const focusUp) x [1..n]
@@ -148,7 +147,7 @@ prop_focusDown_I (n :: NonNegative Int) (x :: T) =
 prop_focus_I (n :: NonNegative Int) (x :: T) =
     case peek x of
         Nothing -> True
-        Just _  -> let w = focus . stack . workspace . current $ foldr (const focusUp) x [1..n]
+        Just _  -> let w = focus . fromJust . stack . workspace . current $ foldr (const focusUp) x [1..n]
                    in invariant $ focusWindow w x
 
 prop_insertUp_I n (x :: T) = invariant $ insertUp n x
@@ -166,41 +165,40 @@ prop_swap_right_I (n :: NonNegative Int) (x :: T) =
     invariant $ foldr (const swapDown) x [1..n]
 
 prop_shift_I (n :: NonNegative Int) (x :: T) =
-    fromIntegral n < size x ==> invariant $ shift (fromIntegral n) x
+    n `tagMember` x ==> invariant $ shift (fromIntegral n) x
 
 
 -- ---------------------------------------------------------------------
 -- 'new'
 
 -- empty StackSets have no windows in them
-prop_empty (n :: Positive Int)
-           (m :: Positive Int) =
-       all (== Empty) [ stack w | w <- workspace (current x)
+prop_empty (EmptyStackSet x) = 
+        all (== Nothing) [ stack w | w <- workspace (current x)
                                         : map workspace (visible x) ++ hidden x ]
 
-    where x = new (fromIntegral n) (fromIntegral m) :: T
-
--- empty StackSets always have focus on workspace 0
-prop_empty_current (n :: Positive Int)
-                   (m :: Positive Int) = tag (workspace $ current x) == 0
-    where x = new (fromIntegral n) (fromIntegral m) :: T
+-- empty StackSets always have focus on first workspace
+prop_empty_current (NonEmptyNubList ns) (NonEmptyNubList sds) =
+    -- TODO, this is ugly
+    length sds <= length ns ==>
+    tag (workspace $ current x) == head ns
+    where x = new ns sds :: T
 
 -- no windows will be a member of an empty workspace
-prop_member_empty i (n :: Positive Int) (m :: Positive Int)
-    = member i (new (fromIntegral n) (fromIntegral m) :: T) == False
+prop_member_empty i (EmptyStackSet x)
+    = member i x == False
 
 -- ---------------------------------------------------------------------
 -- viewing workspaces
 
 -- view sets the current workspace to 'n'
-prop_view_current (x :: T) (n :: NonNegative Int) = i < size x ==>
+prop_view_current (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
     tag (workspace $ current (view i x)) == i
   where
     i = fromIntegral n
 
 -- view *only* sets the current workspace, and touches Xinerama. 
 -- no workspace contents will be changed.
-prop_view_local  (x :: T) (n :: NonNegative Int) = i < size x ==>
+prop_view_local  (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
     workspaces x == workspaces (view i x)
   where
     workspaces a = sortBy (\s t -> tag s `compare` tag t) $
@@ -209,22 +207,45 @@ prop_view_local  (x :: T) (n :: NonNegative Int) = i < size x ==>
     i = fromIntegral n
 
 -- view should result in a visible xinerama screen
--- prop_view_xinerama (x :: T) (n :: NonNegative Int) = i < size x ==>
+-- prop_view_xinerama (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
 --     M.member i (screens (view i x))
 --   where
 --     i = fromIntegral n
 
 -- view is idempotent
-prop_view_idem (x :: T) r =
-    let i = fromIntegral $ r `mod` sz
-        sz = size x
-    in view i (view i x) == (view i x)
+prop_view_idem (x :: T) (i :: NonNegative Int) = i `tagMember` x ==> view i (view i x) == (view i x)
 
 -- view is reversible, though shuffles the order of hidden/visible
-prop_view_reversible r (x :: T) = normal (view n (view i x)) == normal x
+prop_view_reversible (i :: NonNegative Int) (x :: T) =
+    i `tagMember` x ==> normal (view n (view i x)) == normal x
+    where n  = tag (workspace $ current x)
+
+-- ---------------------------------------------------------------------
+-- greedyViewing workspaces
+
+-- greedyView sets the current workspace to 'n'
+prop_greedyView_current (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
+    tag (workspace $ current (greedyView i x)) == i
+  where
+    i = fromIntegral n
+
+-- greedyView *only* sets the current workspace, and touches Xinerama. 
+-- no workspace contents will be changed.
+prop_greedyView_local  (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
+    workspaces x == workspaces (greedyView i x)
+  where
+    workspaces a = sortBy (\s t -> tag s `compare` tag t) $
+                                    workspace (current a)
+                                    : map workspace (visible a) ++ hidden a
+    i = fromIntegral n
+
+-- greedyView is idempotent
+prop_greedyView_idem (x :: T) (i :: NonNegative Int) = i `tagMember` x ==> greedyView i (greedyView i x) == (greedyView i x)
+
+-- greedyView is reversible, though shuffles the order of hidden/visible
+prop_greedyView_reversible (i :: NonNegative Int) (x :: T) =
+    i `tagMember` x ==> normal (greedyView n (greedyView i x)) == normal x
     where n  = tag (workspace $ current x)
-          sz = size x
-          i  = fromIntegral $ r `mod` sz
 
 -- normalise workspace list
 normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) }
@@ -257,12 +278,9 @@ prop_member_peek (x :: T) =
 -- the list returned by index should be the same length as the actual
 -- windows kept in the zipper
 prop_index_length (x :: T) =
-    case it of
-        Empty   -> length (index x) == 0
-        Node {} -> length (index x) == length list
-  where
-    it   = stack . workspace . current $ x
-    list = focus it : up it ++ down it
+    case stack . workspace . current $ x of
+        Nothing   -> length (index x) == 0
+        Just it -> length (index x) == length (focus it : up it ++ down it)
 
 -- ---------------------------------------------------------------------
 -- rotating focus
@@ -293,7 +311,7 @@ prop_focusWindow_works (n :: NonNegative Int) (x :: T) =
         Nothing -> True
         Just _  -> let s = index x
                        i = fromIntegral n `mod` length s
-                   in (focus . stack . workspace . current) (focusWindow (s !! i) x) == (s !! i)
+                   in (focus . fromJust . stack . workspace . current) (focusWindow (s !! i) x) == (s !! i)
 
 -- rotation through the height of a stack gets us back to the start
 prop_focus_all_l (x :: T) = (foldr (const focusUp) x [1..n]) == x
@@ -324,17 +342,15 @@ prop_focusWindow_local (n :: NonNegative Int) (x::T ) =
 prop_findIndex (x :: T) =
     and [ tag w == fromJust (findIndex i x)
         | w <- workspace (current x) : map workspace (visible x)  ++ hidden x
-        , let t = stack w
-        , t /= Empty
-        , i <- focus (stack w) : up (stack w) ++ down (stack w)
+        , t <- maybeToList (stack w)
+        , i <- focus t : up t ++ down t
         ]
 
 -- ---------------------------------------------------------------------
 -- 'insert'
 
 -- inserting a item into an empty stackset means that item is now a member
-prop_insert_empty i (n :: Positive Int) (m :: Positive Int) = member i (insertUp i x)
-    where x = new (fromIntegral n) (fromIntegral m) :: T
+prop_insert_empty i (EmptyStackSet x)= member i (insertUp i x)
 
 -- insert should be idempotent
 prop_insert_idem i (x :: T) = insertUp i x == insertUp i (insertUp i x)
@@ -347,10 +363,8 @@ prop_insert_local (x :: T) i = not (member i x) ==> hidden_spaces x == hidden_sp
 
 -- Inserting a (unique) list of items into an empty stackset should
 -- result in the last inserted element having focus.
-prop_insert_peek (n :: Positive Int) (m :: Positive Int) (NonEmptyNubList is) =
+prop_insert_peek (EmptyStackSet x) (NonEmptyNubList is) =
     peek (foldr insertUp x is) == Just (head is)
-    where
-        x = new (fromIntegral n) (fromIntegral m) :: T
 
 -- insert >> delete is the identity, when i `notElem` .
 -- Except for the 'master', which is reset on insert and delete.
@@ -361,11 +375,10 @@ prop_insert_delete n x = not (member n x) ==> delete n (insertUp n y) == (y :: T
                          -- otherwise, we don't have a rule for where master goes.
 
 -- inserting n elements increases current stack size by n
-prop_size_insert is (n :: Positive Int) (m :: Positive Int) =
+prop_size_insert is (EmptyStackSet x) =
         size (foldr insertUp x ws ) ==  (length ws)
   where
     ws   = nub is
-    x    = new (fromIntegral n) (fromIntegral m) :: T
     size = length . index
 
 
@@ -398,6 +411,36 @@ prop_delete_local (x :: T) =
 -- delete should not affect focus unless the focused element is what is being deleted
 prop_delete_focus n (x :: T) = member n x && Just n /= peek x ==> peek (delete n x) == peek x
 
+-- focus movement in the presence of delete:
+-- when the last window in the stack set is focused, focus moves `up'.
+-- usual case is that it moves 'down'.
+prop_delete_focus_end (x :: T) =
+    length (index x) > 1
+   ==>
+    peek (delete n y) == peek (focusUp y)
+  where
+    n = last (index x)
+    y = focusWindow n x -- focus last window in stack
+
+-- focus movement in the presence of delete:
+-- when not in the last item in the stack, focus moves down
+prop_delete_focus_not_end (x :: T) =
+    length (index x) > 1 &&
+    n /= last (index x)
+   ==>
+    peek (delete n x) == peek (focusDown x)
+  where
+    Just n = peek x
+
+-- ---------------------------------------------------------------------
+-- filter
+
+-- preserve order
+prop_filter_order (x :: T) =
+    case stack $ workspace $ current x of
+    	Nothing -> True
+        Just s@(Stack i _ _) -> integrate' (S.filter (/= i) s) == filter (/= i) (integrate' (Just s))
+
 -- ---------------------------------------------------------------------
 -- swapUp, swapDown, swapMaster: reordiring windows
 
@@ -442,15 +485,13 @@ prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x
 
 -- shift is fully reversible on current window, when focus and master
 -- are the same. otherwise, master may move.
-prop_shift_reversible (r :: Int) (x :: T) =
-    let i  = fromIntegral $ r `mod` sz
-        sz = size y
-        n  = tag (workspace $ current y)
-    in case peek y of
-        Nothing -> True
-        Just _  -> normal ((view n . shift n . view i . shift i) y) == normal y
+prop_shift_reversible i (x :: T) =
+    i `tagMember` x ==> case peek y of
+                          Nothing -> True
+                          Just _  -> normal ((view n . shift n . view i . shift i) y) == normal y
     where
         y = swapMaster x
+        n = tag (workspace $ current y)
 
 ------------------------------------------------------------------------
 -- some properties for layouts:
@@ -507,6 +548,12 @@ main = do
 --      ,("view / xinerama"     , mytest prop_view_xinerama)
         ,("view is local"       , mytest prop_view_local)
 
+        ,("greedyView : invariant"    , mytest prop_greedyView_I)
+        ,("greedyView sets current"   , mytest prop_greedyView_current)
+        ,("greedyView idempotent"     , mytest prop_greedyView_idem)
+        ,("greedyView reversible"     , mytest prop_greedyView_reversible)
+        ,("greedyView is local"       , mytest prop_greedyView_local)
+--
 --      ,("valid workspace xinerama", mytest prop_lookupWorkspace)
 
         ,("peek/member "        , mytest prop_member_peek)
@@ -544,6 +591,10 @@ main = do
         ,("delete is reversible", mytest prop_delete_insert)
         ,("delete is local"     , mytest prop_delete_local)
         ,("delete/focus"        , mytest prop_delete_focus)
+        ,("delete  last/focus up", mytest prop_delete_focus_end)
+        ,("delete ~last/focus down", mytest prop_delete_focus_not_end)
+
+        ,("filter preserves order", mytest prop_filter_order)
 
         ,("swapMaster: invariant", mytest prop_swap_master_I)
         ,("swapUp: invariant" , mytest prop_swap_left_I)
@@ -704,7 +755,6 @@ instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where
   arbitrary   = NonEmptyNubList `fmap` ((liftM nub arbitrary) `suchThat` (not . null))
   coarbitrary = undefined
 
-
 type Positive a = NonZero (NonNegative a)
 
 newtype NonZero a = NonZero a
@@ -725,6 +775,15 @@ instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonNegative a) where
       ]
   coarbitrary = undefined
 
+newtype EmptyStackSet = EmptyStackSet T deriving Show
+
+instance Arbitrary EmptyStackSet where
+    arbitrary = do
+        (NonEmptyNubList ns)  <- arbitrary
+        (NonEmptyNubList sds) <- arbitrary
+        -- there cannot be more screens than workspaces:
+        return . EmptyStackSet . new ns $ take (min (length ns) (length sds)) sds
+
 -- | Generates a value that satisfies a predicate.
 suchThat :: Gen a -> (a -> Bool) -> Gen a
 gen `suchThat` p =

tests/loc.hs

@@ -8,7 +8,6 @@ main = do foo <- getContents
           putStrLn $ show loc
           -- uncomment the following to check for mistakes in isntcomment
           -- putStr $ unlines $ actual_loc
-          when (loc > 550) $ fail "Too many lines of code!"
 
 isntcomment "" = False
 isntcomment ('-':'-':_) = False

xmonad.cabal

@@ -1,5 +1,5 @@
 name:               xmonad
-version:            0.2
+version:            0.3
 homepage:           http://xmonad.org
 synopsis:           A lightweight X11 window manager.
 description:
@@ -18,13 +18,14 @@ license:            BSD3
 license-file:       LICENSE
 author:             Spencer Janssen
 maintainer:         sjanssen@cse.unl.edu
-build-depends:      base>=1.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0
+build-depends:      base>=2.0, X11>=1.2.1, X11-extras>=0.3, mtl>=1.0, unix>=1.0
 extra-source-files: README TODO tests/loc.hs tests/Properties.hs man/xmonad.1.in
                     Config.hs-boot util/GenerateManpage.hs man/xmonad.1 man/xmonad.html
 
 executable:         xmonad
 main-is:            Main.hs
 other-modules:      Config Operations StackSet XMonad
-ghc-options:        -funbox-strict-fields -O -fasm -Wall -optl-Wl,-s
+ghc-options:        -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s
 ghc-prof-options:   -prof -auto-all
 extensions:         GeneralizedNewtypeDeriving
+-- Also requires deriving Typeable